C:----------------------------------------------------------------------
C:
C:       NRLXRF, A FORTRAN PROGRAM FOR X-RAY FLUORESCENCE ANALYSIS
C:
C:              J.W. CRISS, U.S. NAVAL RESEARCH LABORATORY
C:              WASHINGTON, D.C. 20375, U.S.A.    25-JUL-1977
C:
C:    APPROVED FOR PUBLIC RELEASE; DISTRIBUTION UNLIMITED.
C:
C:    CITATION:
C:      J.W. CRISS
C:      NRLXRF, A FORTRAN PROGRAM FOR X-RAY FLUORESCENCE ANALYSIS
C:      U.S. NAVAL RESEARCH LABORATORY PROGRAM DOD-00065 (MOD JULY 1977)
C:      COMPUTER SOFTWARE MANAGEMENT AND INFORMATION CENTER  (COSMIC)
C:      BARROW HALL, UNIVERSITY OF GEORGIA, ATHENS, GEORGIA 30601, USA
C:
C:----------------------------------------------------------------------
C:
C:  SOFTWARE PACKAGE
C:
C:      THE MAGNETIC TAPE SUPPLIED BY COSMIC SHOULD CONTAIN 5 FILES:
C:             NRLXRF    XRDATP    XRDATS    XRDATC    NRLDOC
C:
C:      THE FILE  NRLXRF  CONTAINS ALL THE FORTRAN SOURCE CODE.
C:
C:      THE DATA FILE NAMES AND CONTENTS ARE
C:         XRDATP    FUNDAMENTAL PHYSICAL PARAMETERS FOR THE ELEMENTS
C:         XRDATS    X-RAY SPECTRA FROM TUBES, ISOTOPES, ETC.
C:         XRDATC    DEFINITIONS OF COMPOUNDS AND OTHER COMBINATIONS
C:         XRDAT2    DATA FOR USERS' RUNS (NOT PROVIDED)
C:         XRDAT3    DATA FOR USERS' RUNS (NOT PROVIDED)
C:         XRDAT4    DATA FOR USERS' RUNS (NOT PROVIDED)
C:
C:      THE FILE  NRLDOC  IS THE DOCUMENTATION:
C:         NRLXRF, A FORTRAN PROGRAM FOR X-RAY FLUORESCENCE ANALYSIS:
C:            USERS REFERENCE MANUAL AND GENERAL DOCUMENTATION
C:         J. W. CRISS, NAVAL RESEARCH LABORATORY
C:         WASHINGTON, D.C.    JULY 1977
C:
C:
C:  SOURCE LANGUAGE AND COMPUTERS
C:
C:   THE PROGRAMMING LANGUAGE IS A FAIRLY STANDARD "FORTRAN 4".
C:   IN PARTICULAR, THIS PROGRAM RUNS ON THE N.R.L. DEC-10
C:   TIMESHARING COMPUTER (PDP-10), UNDER THE OPERATING SYSTEM
C:   TOPS-10, VERSION 6.02, AND THE COMPILER DEC FORTRAN 10,
C:   VERSION 4A.
C:
C:   AN ATTEMPT WAS MADE TO MAKE THE PROGRAM CONFORM TO ANSI
C:   STANDARD FORTRAN (AMERICAN NATIONAL STANDARDS INSTITUTE
C:   X3.9-1966), WHEN PRACTICABLE.  NOTABLE EXCEPTIONS TO THAT
C:   STANDARD ARE (1) DATA STATEMENTS -- THIS PROGRAM USES AN
C:   ARRAY NAME, RATHER THAN LISTING SEPARATE ARRAY ELEMENTS;
C:   (2) ENCODE AND DECODE ARE USED; HOWEVER, THESE STATEMENTS MAY
C:   BE ELIMINATED, AND THE STATEMENTS (NOW COMMENTS) BEGINNING
C:   WITH "C:SCR" MAY BE USED INSTEAD -- THEY USE A SCRATCH FILE,
C:   INSTEAD OF CORE, FOR RE-WRITING AND READING INPUT DATA.
C:   (3) UNDEFINITION OF VARIABLES LOCAL TO SUBPROGRAMS -- THIS
C:   PROGRAM ASSUMES THAT NO VARIABLE IN A SUBPROGRAM BECOMES
C:   UNDEFINED UPON EXECUTION OF A RETURN STATEMENT.  THE
C:   CHARACTER SET USED IN COMMENT STATEMENTS IS NOT THE ANSI
C:   FORTRAN STANDARD, BUT INCLUDES ONLY THOSE CHARACTERS THAT
C:   MOST COMPUTER INSTALLATIONS HAVE AVAILABLE.
C:
C:   FOR SOME INSTALLATIONS, SYSTEM-IMPOSED LIMITATIONS WILL
C:   NECESSITATE MINOR RE-PROGRAMMING; FOR EXAMPLE, TO AVOID
C:   EXCEEDING THE ALLOWED NUMBER OF I/O DEVICES AVAILABLE
C:   AT THE SAME TIME, OR THE NUMBER OF CONTINUATION STATEMENTS,
C:   OR THE SIZES OF DIMENSIONED ARRAYS, ETC.  INFORMATION
C:   ON THE LOGICALLY CONSISTENT SIZES OF ARRAYS IS GIVEN IN
C:   COMMENTS IN THE MAIN PROGRAM.  ONE MAY OMIT ALL OF THE
C:   "DOUBLE PRECISION" STATEMENTS FOR COMPUTERS (LIKE THE CDC-6400)
C:   THAT CAN STORE A 8-CHARACTER HOLLERITH EXPRESSION AS A SINGLE
C:   WORD.  THE ONLY "DOUBLE PRECISION" STATEMENTS THAT AFFECT
C:   COMPUTATION (RATHER THAN HOLLERITH INFORMATION) ARE THOSE IN
C:   THE SUBROUTINES SOLV, SOLV2, AND SOLV3.
C:
C:
C:  CODING STYLE
C:
C:    ALTHOUGH NOT NECESSARY FOR FORTRAN, THE FOLLOWING POINTS
C:    OF STYLE IN CODING WERE OBSERVED, FOR THE PURPOSES OF
C:    UNIFORMITY, READABILITY, AND (ESPECIALLY) EASE IN
C:    EDITING BY MEANS OF AN INTERACTIVE EDITOR.  THESE RULES
C:    DO NOT APPLY TO COMMENTS AND HOLLERITH INFORMATION.
C:
C:    SYMBOLIC NAMES AND CONSTANTS ARE PRECEDED BY A BLANK
C:    IN EVERY OCCURRENCE. (MINUS, WHEN USED AS A SIGN, RATHER
C:    THAN AS AN OPERATOR, IS CONSIDERED PART OF A CONSTANT,
C:    BUT IS SEPARATED FROM A VARIABLE NAME)
C:
C:    THE OPERATORS, "+", "-", "*", "/", "**", AND THE
C:    SEPARATORS ")" AND ",", ARE NOT PRECEDED BY BLANKS.
C:    MINUS ("-"), WHEN USED AS A SIGN, IS PRECEDED BY A BLANK.
C:
C:    (IN THE FOLLOWING, "IFF" MEANS "IF, AND ONLY IF,")
C:    A VARIABLE NAME BEGINS WITH THE LETTER
C:     I   ONLY IF IT IS A SUBSCRIPT OR DO-LOOP INDEX
C:     A-G, O-Z,   IFF IT IS TYPE REAL
C:     I, J, K, L, M, N   IFF IT IS TYPE INTEGER
C:     H   IFF IT CONTAINS HOLLERITH INFORMATION (I/O BY "A"),
C:        EXCEPT THAT THE ARRAY SDUMP IN SUBROUTINE DUMPS CONTAINS
C:        BOTH HOLLERITH AND NUMERIC INFORMATION.
C:MAC  Modified to run on a Macintosh, 4/23/93 by W. T. Elam, NRL
C:MAC    Hollerith variable HIN changed to Character*16 because of compiler 
C:MAC    ideosyncracy in handling decodes.
C:
C:    HOPEFULLY, NO SYMBOLIC NAME (BESIDES THE INTRINSIC
C:    FUNCTIONS MIN0, MAX0, AND ALOG10) CONTAINS A ZERO ("0").
C:    IF IN DOUBT ABOUT WHETHER A CHARACTER IS THE NUMERAL "0"
C:    OR THE LETTER "O", ASSUME IT IS THE LETTER "O".
C:
C:    ALL CONTINUATION STATEMENTS HAVE THE NUMERAL "1" IN THE
C:    APPROPRIATE COLUMN.  MOREOVER, THAT IS THE ONLY KIND OF
C:    OCCURRENCE OF THE CHARACTER-STRING "     1".  THIS FEATURE
C:    PERMITS EASY MODIFICATION OF THE PROGRAM FOR CDC KRONOS
C:    TIMESHARING FORTRAN.
C:
C:    ALL COMMENT LINES BEGIN WITH "C:"; MORE SPECIFIC EXAMPLES ARE
C:CDC  FOR LINES TO BE USED IN CDC KRONOS TIMESHARING
C:DOC  FOR GENERAL DOCUMENTATION
C:DIM  FOR MINIMUM DIMENSIONS OF ARRAYS
C:ALT  FOR ALTERNATE COMPUTATIONS AND I/O (VESTIGES OF EARLIER VERSIONS)
C:I/O  FOR I/O UNIT DESCRIPTIONS AND I/O OPTIONS
C:BUG  FOR OPTIONAL OUTPUT, ETC. IN DEBUGGING
C:SCR  FOR STATEMENTS TO BE USED IN PLACE OF ENCODE/DECODE
C:-------FOR SPACING TO MAKE CODING EASIER TO FOLLOW
C:MOD  BEGIN    FOR THE BEGINNING OF A SECTION OF OPTIONAL CODING
C:MOD  END      FOR THE END OF A SECTION OF OPTIONAL CODING
C:****BEGIN   FOR THE BEGINNING OF A SUB-PROGRAM
C:****END     FOR THE END OF A SUB-PROGRAM
C:
C:----------------------------------------------------------------------
C:****BEGIN   MAIN
       Character*16 HIN
C:CDC       PROGRAM XRFA( INPUT, OUTPUT, TAPE1, TAPE2, TAPE3,
C:CDC     1 TAPE4, TAPE5= INPUT, TAPE6= OUTPUT, TAPE7, TAPE8,
C:CDC     1 TAPE9, TAPE10)
      DOUBLE PRECISION HXU, HEX, HSAMP, HXS
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
C:DIM /KIO/ HIN( 200)
C:
C:I/O  THE VARIABLES IN COMMON/KIO/ (ABOVE) ARE USED TO CONTROL
C:I/O       INPUT, OUTPUT, AND LOGIC FLOW:
C:I/O  KR = THE INPUT UNIT NUMBER.
C:I/O  KS = THE I/O UNIT NUMBER FOR THE SCRATCH FILE (IF USED).
C:I/O  KW = THE OUTPUT UNIT NUMBER.
C:I/O  KEND = THE NUMBER OF DATA IN THE LAST FREE-FIELD RECORD.
C:I/O  IH  IS THE CURRENT SUBSCRIPT FOR ARRAY HIN (SEE NEXT).
C:I/O  HIN IS THE ARRAY FROM WHICH REFORMATTED INPUT IS DECODED.
C:
C:
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
C:
C:DIM  THE FOLLOWING VARIABLES ARE USED TO TEST INPUT AGAINST
C:DIM    ARRAY SIZE OF VARIOUS DIMENSIONED VARIABLES.
C:DIM    THEREFORE, CHANGES IN DIMENSIONED ARRAY SIZES SHOULD
C:DIM    MAINTAIN THE PRESENT RELATIONSHIP AMONG ARRAY SIZES
C:DIM    AND THE VALUES OF THESE VARIABLES.  THE REQUIRED, OR
C:DIM    MINIMUM ALLOWED, SIZES ARE GIVEN IN COMMENTS AFTER
C:DIM    THE COMMON STATEMENTS BELOW (WHICH INCLUDE ALL LABELED
C:DIM    COMMONS USED IN THE PROGRAMS), AND IN COMMENTS FOLLOWING
C:DIM    APPROPRIATE DIMENSION AND DATA STATEMENTS IN VARIOUS
C:DIM    SUBPROGRAMS.
C:
C:DOC  MNW IS THE MAX. NO. OF POINTS IN ALL SPECTRA USED
C:DOC  MNIN IS THE MAX. NO. OF POINTS USED FOR CALCULATION
C:DOC  MNX IS THE NUMBER OF INDEPENDENT COMPONENTS OF THE SAMPLE
C:DOC  MNY IS THE NO. OF MEASUREMENTS.
C:DOC  MNEL IS THE NUMBER OF ELEMENTS PRESENT.
C:DOC  MNOL IS THE NO. OF CHARACTERISTIC LINES THAT MUST BE
C:DOC    CONSIDERED FOR A TREATMENT OF SECONDARY FLUORESCENCE.
C:DOC  MNS IS THE NO. OF SAMPLES, INCL. AUTO. SIMULATION, PLUS 1.
C:
C:XXX
C:XXX
C:
C:MOD  BEGIN                                OMIT FROM NRLEMP
      COMMON/SPEC1/ NW1, W1( 300), SP1( 300), JSP1( 31), NSP
C:DIM /SPEC1/ W1( MNW), SP1( MNW), JSP1( MNY+ 1)
      COMMON/SPEC2/ NW2, W2( 80), SP2( 300), JSP2( 30), RMESH
C:DIM /SPEC2/ W2( MNIN), SP2( MNW), JSP2( MNY)
      COMMON/CSCS/ CSC1( 30), CSC2( 30)
C:DIM /CSCS/ CSC1( MNY), CSC2( MNY)
      COMMON/LMC/ PURE( 30), ROMZ( 30), YY( 30)
C:DIM /LMC/ PURE( MNY), ROMZ( MNY), YY( MNY)
      COMMON/PARAM/ NOL, JZL( 50), L6( 50), WLL( 50), JWL( 50),
     1 UC( 20, 50), BC( 20, 80)
C:DIM /PARAM/ JZL( MNOL), L6( MNOL), WLL( MNOL), JWL( MNOL),
C:DIM    UC( MNEL, MNOL), BC( MNEL, MNIN)
      COMMON/YNORC/ YNOR( 51, 30)
C:DIM /YNORC/ YNOR( MNS, MNY)
C:MOD  END                                  OMIT FROM NRLEMP
C:MOD  BEGIN            OMIT FROM NRLSIM
      COMMON/GB/ GAM( 30, 21), BET( 30, 21), GG( 22, 22)
C:DIM /GB/ GAM( MNY, MNX+ 1), BET( MNY, MNX+ 1), GG( MNX+ 2, MNX+ 2)
C:MOD  END              OMIT FROM NRLSIM
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
C:MOD  BEGIN                                OMIT FROM NRLEMP
      COMMON/EXPT/ NEXPT, HEX( 30, 3), TEX( 30, 8)
C:DIM /EXPT/ HEX( MNY, 3), TEX( MNY, 8)
C:MOD  END                                  OMIT FROM NRLEMP
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
C:DIM /LMEAS/ NZY( MNY), HLY( MNY), JSPY( MNY), JLM( MNY)
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
C:DIM /SAM/ HSAMP( MNS), PS( MNS, 7)
      COMMON/SAMX/ HXS( 51, 20), X1( 51, 20, 2)
C:DIM /SAMX/ HXS( MNS, MNX), X1( MNS, MNX, 2)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
C:DIM /SAMY/ Y1( MNS, MNY), YE( MNS, MNY), YN( MNY), YPAR( MNY, 7)
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
C:DIM /COMPS/ NZEL( MNEL), PELC( MNEL, MNX)
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
C:DIM /COMP2/ HXU( MNX), DEN1( MNX), TBAR1( MNX), XU( MNX)
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
C:DIM /STD/ YNOR1( MNS)
C:MOD  BEGIN                                OMIT FROM NRLEMP
      COMMON/GRAIN/ TBAR( 20), DEN( 20), VVOID, TVOID
C:DIM /GRAIN/ TBAR( MNX), DEN( MNX)
C:MOD  END                                  OMIT FROM NRLEMP
      COMMON/HFS/ HFE( 3), HFA( 2)
C:DIM /HFS/ HFE( 3), HFA( 2)
C:
      COMMON/KUS/ KU( 10)
C:DIM /KUS/ KU( 10)
C:I/O  KU CONTAINS 10 I/O UNIT NUMBERS FOR THE DEVICE ASSIGNMENTS
C:I/O  DESCRIBED IN A TABLE BELOW.  VALUES IN KU ARE SET IN A DATA
C:I/O  STATEMENT IN THE BLOCK DATA SUBPROGRAM.
C:
      DIMENSION JZY( 30)
C:DIM  JZY( MNY)
C:
C:DELETE LINES 10401, 10411, 10871--10941, AND 10961--10981.
C:XXX
C:XXX
C:XXX
C:XXX
C:XXX
C:XXX
C:XXX
C:XXX
      DATA NQ/ 30/
C:XXX
C:XXX
C:XXX
C:
C:I/O  INPUT/OUTPUT DEVICE ASSIGNMENTS:
C:I/O  UNIT.... I/O....... DEVICE...... KIND OF INFORMATION
C:I/O  1....... READ...... DISK........ INCIDENT SPECTRA
C:SCR  2... READ/ WRITE... DISK........ INPUT SCRATCH FILE
C:I/O  3....... READ...... DISK........ COMPOUNDS DEFINITIONS
C:I/O  4....... READ...... DISK........ MASTER DATA FILE
C:I/O  5....... READ...... TERMINAL.... INPUT CONVERSATION
C:I/O  6....... WRITE..... TERMINAL.... PROGRAM OUTPUT
C:I/O  7....... READ...... DISK........ ALTERNATE PROG. INPUT
C:I/O  8....... WRITE..... DISK........ ALTERNATE PROG. OUTPUT
C:I/O  9....... READ...... DISK........ ALTERNATE PROG. INPUT
C:I/O  10...... READ...... DISK........ ALTERNATE PROG. INPUT
C:
C:I/O  THE FOLLOWING "CALL FILIO"'S, WHICH ESTABLISH THE
C:I/O    APPROPRIATE DEVICES AND/OR DATA FILES, MAY NEED TO
C:I/O    BE ADAPTED TO VARIOUS COMPUTER INSTALLATIONS.
C:I/O  ALL DATA ARE TRANSFERRED IN ASCII MODE.
C:I/O  ALL FILES ARE ACCESSED IN SEQUENTIAL FASHION.
C:
C:----------
C:I/O THE FOLLOWING  CALL FILIO  IS DONE IN SUBROUTINE SPIN
C:    CALL FILIO( 1, 1, 1, 1, 1)
C:SCR      CALL FILIO( 2, 2, 1, 3, 1)
C:I/O THE FOLLOWING  CALL FILIO  IS DONE IN SUBROUTINE DEFD
C:    CALL FILIO( 3, 3, 1, 1, 1)
C:I/O THE FOLLOWING  CALL FILIO  IS DONE IN FUNCTION SUBPROGRAM AF(
C:    CALL FILIO( 4, 4, 1, 1, 1)
      CALL FILIO( 5, 5, 2, 1, 1)
      CALL FILIO( 6, 6, 2, 2, 1)
      CALL FILIO( 7, 7, 1, 1, 1)
      CALL FILIO( 8, 8, 1, 2, 1)
      CALL FILIO( 9, 9, 1, 1, 1)
      CALL FILIO( 10, 10, 1, 1, 1)
C:BUG      WRITE( 6, 601)
C:BUG601   FORMAT( 2X, 10H----------)
C:BAT FOR BATCH PROCESSING, ADD LINES 11346, 18036, AND 18116
C:BAT      CALL IN( 999, -4, 2, KEND, HIN)
      CALL IN( KU( 1), 0, 2, KEND, HIN)
      CALL IN( KU( 3), 0, 2, KEND, HIN)
      CALL IN( KU( 4), 0, 2, KEND, HIN)
      CALL IN( KU( 5), 0, 2, KEND, HIN)
      CALL IN( KU( 7), 0, 2, KEND, HIN)
      CALL IN( KU( 9), 0, 2, KEND, HIN)
      CALL IN( KU( 10), 0, 2, KEND, HIN)
C:BUG      WRITE( 6, 601)
      IF ( MNY.GT. MNOL) MNY= MNOL
      WRITE( KW, 201)
 201  FORMAT(// 2X, 70( 1H=)// 2X, 26HX-RAY FLUORESCENCE PROGRAM,
     1 8H        )
      WRITE( KW, 202)
 202  FORMAT(/ 2X, 49HNAVAL RESEARCH LABORATORY,  JWC VERSION 25-JUL-77,
     1 / 2X, 24H UPDATE NRL JWC  JULY 78,
     1 / 2X, 24H UPDATE NRL JWC MARCH 79,
     1 / 2X, 25H UPDATE NRL JWC AUGUST 79,
     1 / 2X, ' UPDATE NRL WTE APRIL 93 (Mac)',
     1 /)
      KA= 0
      CALL IN( KA, -2, 2, KEND, HIN)
      CALL IN( 1, -7, 2, KEND, HIN)
       KPREP= 1
C:MOD  BEGIN                                OMIT FROM NRLEMP
       KERR= AF( -1, KUF( 4))
C:MOD  END                                  OMIT FROM NRLEMP
C:-------
      IF ( NQ.NE. 30) GO TO 10
 1    CONTINUE
      IF ( NQ.EQ. 30) CALL RESET( NX, NY, NEL)
      IF ( NQ.EQ. 31) KLY= 2
      IF ( NQ.EQ. 31) CALL LINE( KLY, NY, NEL)
      IF ( NQ.EQ. 32) CALL SAMP
      IF ( NQ.EQ. 32) CALL COMP( NX, NEL)
      IF ( NQ.EQ. 33) CALL MEAS( NQ, NY)
      IF ( NQ.EQ. 37) CALL MEAS( NQ, NY)
      IF ( NQ.EQ. 34) CALL  JZYS( NZY, JZY, NY, NZEL, NEL)
C:MOD  BEGIN                                OMIT FROM NRLEMP
      IF ( NQ.EQ. 34) CALL SNORM( NX, NY, NEL, JZY)
C:MOD  END                                  OMIT FROM NRLEMP
      IF ( NQ.EQ. 35) CALL MEAS( NQ, NY)
      IF ( NQ.EQ. 36) CALL DEFIN( NX, NEL)
C:MOD  BEGIN            OMIT FROM NRLSIM
      IF ( NQ.EQ. 38) CALL COEFS( NX, NY)
C:MOD  END              OMIT FROM NRLSIM
      IF ( NQ.GE. 30) GO TO 10
      IF ( NQ.EQ. 1) GO TO 10
      IF ( NQ.GT. 26) GO TO 10
      IF ( NQ.EQ. 3) GO TO 53
      IF ( NQ.GT. 13) CALL ERROR( 0)
      IF ( NQ.GT. 13) GO TO 10
      GO TO 6
C:-------
 53   CONTINUE
      KLY= 1
      CALL LINE( KLY, NY, NEL)
       KPREP= 1
      GO TO 10
C:-------
 6    CONTINUE
      CALL  JZYS( NZY, JZY, NY, NZEL, NEL)
      IF ( NX.LE. 0)  JSR= -JSR
      IF ( NX.LE. 0) CALL COMP( NX, NEL)
      CALL  QUAN( JZY, NQ, NY, NX, NEL)
 10   CALL NEXTQ( NQ, NX, NY, NEL)
      GO TO 1
C:-------
      END
C:****END     MAIN
C:****BEGIN   BLOCK DATA
      BLOCK DATA
       Character*16 HIN
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      COMMON/HFS/ HFE( 3), HFA( 2)
      COMMON/KUS/ KU( 10)
      DATA MNX/ 20/, MNY/ 30/, MNEL/ 20/, MNW/ 300/
      DATA MNIN/ 80/, MNOL/ 50/, MNS/ 51/
      DATA KR/ 5/, KS/ 2/, KW/ 6/, KOUT/ 1/
      DATA KU/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10/
      DATA HFE/ 3H( E, 3H16., 2H0)/, HFA/ 3H( A, 2H4)/
      END
C:****END     BLOCK DATA
C:****BEGIN   RESET
      SUBROUTINE RESET( NX, NY, NEL)
       Character*16 HIN
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      DOUBLE PRECISION HXU, HEX, HSAMP, HXS, HBL6, HW6, HNONE, HUND
C:MOD  BEGIN                                OMIT FROM NRLEMP
      COMMON/GRAIN/ TBAR( 20), DEN( 20), VVOID, TVOID
      COMMON/SPEC1/ NW1, W1( 300), SP1( 300), JSP1( 31), NSP
      COMMON/SPEC2/ NW2, W2( 80), SP2( 300), JSP2( 30), RMESH
      COMMON/LMC/ PURE( 30), ROMZ( 30), YY( 30)
      COMMON/EXPT/ NEXPT, HEX( 30, 3), TEX( 30, 8)
      COMMON/YNORC/ YNOR( 51, 30)
C:MOD  END                                  OMIT FROM NRLEMP
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMX/ HXS( 51, 20), X1( 51, 20, 2)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/HFS/ HFE( 3), HFA( 2)
      DATA HNUL3/ 3H---/, HBL6/ 6H      /, HW6/ 6HW     /
      DATA HNONE/ 6HNONE  /, HUND/ 6H------/
       KPREP= 1
       KADJB= 1
       KIND= 2
       KOP= 4
       KPCT= 1
       BZ= 1.
       XUS= -1.
      RMESH= 1.2
      DO 1 IY= 1, MNY
       YPAR( IY, 1)= 1.
       YPAR( IY, 2)= 0.
       YPAR( IY, 3)= 1.
       YPAR( IY, 4)= 0.
       YPAR( IY, 5)= 0.01
       JSPY( IY)= 1
       YN( IY)= 0.
       YPAR( IY, 7)= 1.
       NZY( IY)= -999
       HLY( IY)= HNUL3
    1 CONTINUE
       NY= 0
C:MOD  BEGIN                                OMIT FROM NRLEMP
C:    RESET OPERATING CONDITIONS
       NEXPT= 1
       HEX( 1, 1)= HW6
       HEX( 1, 2)= HBL6
       HEX( 1, 3)= HNONE
       TEX( 1, 1)= 45.
       TEX( 1, 2)= 45.
       TEX( 1, 3)= 0.
       TEX( 1, 4)= 50.
       TEX( 1, 5)= 0.
       TEX( 1, 7)= 0.017453293* 30.0
      TEX( 1, 8)= 0.185
       KPREP= 1
      DO 11 IY= 1, MNY
      DO 11 IS= 1, MNS
   11 YNOR( IS, IY)= 0.
C:MOD  END                                  OMIT FROM NRLEMP
C:    RESET INCIDENT SPECTRA
       NSP= 0
C:
C:    RESET SAMPLES
       NSAM= 1
       NS1= NSAM
       NSTD= NS1
       HSAMP( 1)= HBL6
       PS( 1, 1)= 0.
       PS( 1, 2)= 1.
       PS( 1, 3)= 100.
       PS( 1, 4)= 1.
       PS( 1, 6)= 0.
       PS( 1, 7)= 0.
C:
C:    RESET COMPOSITIONS -- COMPONENTS AND ELEMENTS
      DO 22 IX= 1, MNX
       HXU( IX)= HUND
   22  TBAR1( IX)= 0.
       JSR= 1
       PS( 1, 1)= 0.
       PS( 1, 5)= 0.
       NEL= 0
       NX= 0
       KPREP= 1
C:
      RETURN
      END
C:****END     RESET
C:****BEGIN   NEXTQ
      SUBROUTINE NEXTQ( NQ, NX, NY, NEL)
       Character*16 HIN
      DOUBLE PRECISION HSAMP, HXS, HXU
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/HFS/ HFE( 3), HFA( 2)
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
C:MOD  BEGIN                                OMIT FROM NRLEMP
      COMMON/SPEC2/ NW2, W2( 80), SP2( 300), JSP2( 30), RMESH
C:MOD  END                                  OMIT FROM NRLEMP
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMX/ HXS( 51, 20), X1( 51, 20, 2)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
      COMMON/GRAIN/ TBAR( 20), DEN( 20), VVOID, TVOID
      COMMON/LMC/ PURE( 30), ROMZ( 30), YY( 30)
      DIMENSION SSTD( 51), YMULT( 30)
C:DIM  SSTD( MNS), YMULT( MNY)
      DATA KPAR/ 0/, HQM/ 3H?  /, KONT/ 1/
      DATA HNO/ 3HNO /, HSIM/ 3HSIM/, HANA/ 3HANA/,
     1 HQUI/ 3HQUI/, HERR/ 3HERR/, HSTO/ 3HSTO/, HTUB/ 3HTUB/,
     1 HRME/ 3HRME/, HHEL/ 3HHEL/, HCON/ 3HCON/, HPAR/ 3HPAR/,
     1 HREM/ 3HREM/, HELE/ 3HELE/, HSTE/ 3HSTE/,
     1 HPCT/ 3HPCT/, HSUM/ 3HSUM/, HCOM/ 3HCOM/, HFAT/ 3HFAT/,
     1 HLIN/ 3HLIN/, HINT/ 3HINT/, HLON/ 3HLON/, HDUM/ 3HDUM/,
     1 HPRO/ 3HPRO/, HNOR/ 3HNOR/, HMUL/ 3HMUL/, HLIS/ 3HLIS/,
     1 HINP/ 3HINP/, HOUT/ 3HOUT/, HDEF/ 3HDEF/, HRES/ 3HRES/,
     1 HEMP/ 3HEMP/, HTHE/ 3HTHE/, HBFR/ 3HBFR/, HBFI/ 3HBFI/,
     1 HMAC/ 3HMAC/, HPRE/ 3HPRE/, HFUL/ 3HFUL/, HCOE/ 3HCOE/
      DATA HTEST/ 3HRES/
C:----------
       KOP1= KOP
C:MOD  BEGIN                                OMIT FROM NRLEMP
      IF ( HTEST.NE. HSIM) GO TO 18
      IF ( JSR.LE. 0) GO TO 18
      IF ( YY( 1).LT. 0.) GO TO 999
      DO 15 IX= 1, NX
       HXS( JSR, IX)= HXU( IX)
       X1( JSR, IX, 1)= XU( IX)
15     X1( JSR, IX, 2)= TBAR( IX)
      PS( JSR, 1)= NX
      IF ( KIND.NE. 3) PS( JSR, 5)= 1.0
      CALL SSTDS( 1, XU, NX, NEL, YY, NY, SSTD, 2, NS1, YMULT)
      DO 17 IY= 1, NY
       Y1( JSR, IY)= YY( IY)* YMULT( IY)
       YE( JSR, IY)= ABS( YPAR( IY, 5))
      IF ( ABS( YMULT( IY)- 1.).GT. 1.E-5) GO TO 17
       YE( JSR, IY)= - ABS( YPAR( IY, 5))
 17   CONTINUE
       KADJY= 1
       YNOR1( JSR)= -1.
C:MOD  END                                  OMIT FROM NRLEMP
 18    YY( 1)= -1.
      GO TO 2
C:-------
 19    CONTINUE
      WRITE( KW, 210)
C:MOD   MODIFY THE FOLLOWING FORMAT FOR NRLSIM OR NRLEMP
 210  FORMAT(/ 2X, 39H KEYWORDS RECOGNIZED BY THE PROGRAM ARE/
     1 / 2X, 52H RESET        LINES        INTENSITIES  ANALYZE     
     1 / 2X, 52H COMPOSITION  NORMALIZE    SUM          PREDICT     
     1 / 2X, 52H DEFINE       ELEMENTS     EMPIRICAL    THEORETICAL 
     1 / 2X, 52H FULL         ERRORS       INPUT        OUTPUT      
     1 / 2X, 52H CONDITIONS   SIMULATE     STEP         MULTIPLIERS 
     1 / 2X, 52H MAC          BFIXED       BFREE        COEFFICIENTS
     1 / 2X, 52H LIST         DUMP         HELP         TUBE        
     1 / 2X, 52H RMESH        QUIT                                  
     1 / 2X, 52H FATAL        PCT          LONG         REMARKS     
     1 / 2X, 52H PARROT                                             
     1 // 2X, 45H THE LAST 5 MAY BE PRECEDED BY THE WORD "NO".
     1 / 2X, 52H ONLY THE FIRST 3 LETTERS OF A KEYWORD ARE REQUIRED./)
 2    CONTINUE
      IF ( KOP.NE. KOP1) KADJB= 1
       KOP1= KOP
      IF ( KR.NE. KUF( 5)) GO TO 5
       KTERM= KUF( 6)
      WRITE( KTERM, 212)
      GO TO 6
C:    -------
 5    IF ( KPAR.NE. 0) WRITE( KW, 213)
 212  FORMAT( 2X, 1H )
 213  FORMAT( 1X, 1H()
 6     KNO= 1
 12    NQ= 100
      CALL IN( KR, 40, 2, KEND, HIN)
       IH= 1
      IF ( KEND.LT. 0) GO TO 991
      IF ( KEND.LT. 1) GO TO 2
 13   CONTINUE
C:SCR      READ( KS, 101) HTEST
      DECODE( 16, 101, HIN( IH)) HTEST
       IH= IH+ 4
       KEND= KEND- 1
 101  FORMAT( A3)
      IF ( HTEST.EQ. HNO) KNO= -KNO
      IF ( HTEST.EQ. HNO) GO TO 13
      IF ( HTEST.EQ. HSTO) NQ= 0
      IF ( HTEST.EQ. HRES) NQ= 30
      IF ( HTEST.EQ. HRES) KONT= 1
      IF ( HTEST.EQ. HCOM) NQ= 32
      IF ( HTEST.EQ. HLIN) NQ= 3
C:MOD  BEGIN                                OMIT FROM NRLEMP
      IF ( HTEST.EQ. HSIM) NQ= 11
      IF ( HTEST.EQ. HPRE) NQ= 11
      IF ( HTEST.EQ. HSIM) KOP= 2
      IF ( HTEST.EQ. HPRE) KOP= 2
C:MOD  END                                  OMIT FROM NRLEMP
C:MOD  BEGIN            OMIT FROM NRLSIM
      IF ( HTEST.EQ. HANA) NQ= 11
C:MOD  END              OMIT FROM NRLSIM
      IF ( HTEST.EQ. HINT) NQ= 33
      IF ( HTEST.EQ. HERR) NQ= 37
C:MOD  BEGIN            OMIT FROM NRLSIM
      IF ( HTEST.EQ. HCOE) NQ= 38
C:MOD  END              OMIT FROM NRLSIM
C:MOD  BEGIN                                OMIT FROM NRLEMP
      IF ( HTEST.EQ. HCON) NQ= 31
      IF ( HTEST.EQ. HRME) NQ= 9
      IF ( HTEST.EQ. HRME) KPREP= 1
      IF ( HTEST.EQ. HNOR) NQ= 34
C:MOD  END                                  OMIT FROM NRLEMP
      IF ( HTEST.EQ. HMUL) NQ= 35
      IF ( HTEST.EQ. HQUI) NQ= 0
      IF ( HTEST.EQ. HLON) NQ= -17
      IF ( HTEST.EQ. HHEL) GO TO 19
      IF ( HTEST.EQ. HFAT) NQ= -11
      IF ( HTEST.EQ. HINP) GO TO 21
      IF ( HTEST.EQ. HOUT) GO TO 21
      IF ( HTEST.EQ. HELE) NQ= 12
      IF ( HTEST.EQ. HPAR) NQ= -9
C:MOD  BEGIN            OMIT FROM NRLSIM
      IF ( HTEST.EQ. HFUL) NQ= 101
      IF ( HTEST.EQ. HFUL) KONT= 1
      IF ( HTEST.EQ. HEMP) NQ= 101
      IF ( HTEST.EQ. HEMP) KONT= 2
      IF ( HTEST.EQ. HTHE) NQ= 101
      IF ( HTEST.EQ. HTHE) KONT= 3
      IF ( HTEST.EQ. HBFR) NQ= 101
      IF ( HTEST.EQ. HBFR) BZ= -1.
      IF ( HTEST.EQ. HPCT) NQ= -13
      IF ( HTEST.EQ. HBFI) NQ= 101
      IF ( HTEST.EQ. HBFI) BZ= 1.
      IF ( HTEST.EQ. HSUM) NQ= 9
      IF ( HTEST.EQ. HSTE) NQ= 13
C:MOD  END              OMIT FROM NRLSIM
C:MOD  BEGIN                                OMIT FROM NRLEMP
      IF ( HTEST.EQ. HMAC) NQ= 101
      IF ( HTEST.EQ. HMAC) CALL MAC
      IF ( HTEST.EQ. HTUB) NQ= 101
      IF ( HTEST.EQ. HTUB) KLY= 3
      IF ( HTEST.EQ. HTUB) CALL COND( KLY)
C:MOD  END                                  OMIT FROM NRLEMP
      IF ( HTEST.EQ. HREM) NQ= -15
      IF ( HTEST.EQ. HDEF) NQ= 36
      IF ( HTEST.EQ. HLIS) NQ= 101
      IF ( HTEST.EQ. HLIS) CALL SAMP
      IF ( HTEST.EQ. HLIS) CALL DUMPS( 1, NX, NY)
      IF ( HTEST.EQ. HDUM) NQ= 101
      IF ( HTEST.EQ. HDUM) CALL DUMPS( 2, NX, NY)
      IF ( NQ.EQ. 101) GO TO 2
      IF ( NQ.EQ. 100) KNO= 1
      IF ( NQ.EQ. 100) GO TO 999
      IF ( NQ.EQ. 99) GO TO 21
      IF ( KNO.GT. 0) GO TO 22
      IF ( HTEST.EQ. HFAT) NQ= -12
      IF ( HTEST.EQ. HPCT) NQ= -14
      IF ( HTEST.EQ. HPAR) NQ= -10
      IF ( HTEST.EQ. HREM) NQ= -16
      IF ( HTEST.EQ. HLON) NQ= -18
       KNO= 1
      GO TO 22
C:-------
 21   CONTINUE
      IF ( KEND.GE. 1) GO TO 23
      CALL IN( KR, 1, 1, KEND, HIN)
       IH= 1
      IF ( KEND.LT. 1) GO TO 991
 23   CONTINUE
C:SCR      READ( KS, HFE) XXX
      DECODE( 16, HFE, HIN( IH)) XXX
       IH= 1
       NQ= XXX
      IF ( HTEST.EQ. HINP) NQ= -NQ
      IF ( HTEST.EQ. HOUT) NQ= -( NQ+ 4)
 22   IF ( NQ.GT. 0) GO TO 4
      IF ( NQ.LT. 0) GO TO 3
      WRITE( KW, 202)
 202  FORMAT(/ 2X, 11HEND OF RUN.// 2X, 70( 1H=))
      ENDFILE KW
      STOP 0
C:-------
 3    CONTINUE
      IF ( NQ.LT. -18) GO TO 992
      IF ( NQ.EQ. -1) KR= KUF( 5)
      IF ( NQ.EQ. -2) KR= KUF( 7)
      IF ( NQ.EQ. -3) KR= KUF( 9)
      IF ( NQ.NE. -4) GO TO 31
      IF ( NQ.EQ. -4) KR= KUF( 10)
 31   IF ( NQ.EQ. -5) KW= KUF( 6)
C:CDC       KUF8= KUF( 8)
C:CDC      IF ( NQ.EQ. -6) WRITE( KW, 208) KUF8
      IF ( NQ.EQ. -6) KW= KUF( 8)
      IF ( NQ.EQ. -9) CALL IN( 1, -2, 2, KEND, HIN)
      IF ( NQ.EQ. -9) KPAR= 1
      IF ( NQ.EQ. -10) CALL IN( 0, -2, 2, KEND, HIN)
      IF ( NQ.EQ. -10) KPAR= 0
      IF ( NQ.EQ. -11) CALL ERROR( -11)
      IF ( NQ.EQ. -12) CALL ERROR( -12)
      IF ( NQ.EQ. -13) KPCT= 1
      IF ( NQ.EQ. -14) KPCT= 0
      IF ( NQ.EQ. -15) CALL IN( 1, -7, 2, KEND, HIN)
      IF ( NQ.EQ. -16) CALL IN( 0, -7, 2, KEND, HIN)
      IF ( NQ.EQ. -17) KOUT= 2
      IF ( NQ.EQ. -18) KOUT= 1
      CALL IN( KW, -5, 2, KEND, HIN)
      GO TO 2
C:-------
 4    CONTINUE
      IF ( HTEST.EQ. HPRE) GO TO 44
      IF ( HTEST.EQ. HSIM) GO TO 44
      IF ( NQ.EQ. 11) GO TO 42
      IF ( NQ.EQ. 13) GO TO 42
      GO TO 44
C:-------
 42   IF ( KONT.EQ. 1) KOP= 4
      IF ( KONT.EQ. 2) KOP= 1
      IF ( KONT.EQ. 3) KOP= 3
 44   CONTINUE
      IF ( KOP.NE. KOP1) KADJB= 1
       KOP1= KOP
      IF ( NQ.EQ. 11) CALL SAMP
      IF ( NQ.EQ. 13) CALL SAMP
      IF ( NQ.NE. 9) GO TO 99
      IF ( KEND.LT. 1) CALL IN( KR, 1, 2, KEND, HIN)
      IF ( KEND.LT. 1)  IH= 1
      IF ( KEND.LT. 1) GO TO 999
C:SCR      READ( KS, 183) HX, XXX
      DECODE( 16, 183, HIN( IH)) HX, XXX
       IH= IH+ 4
 183  FORMAT( A1, E15.0)
      IF ( HTEST.EQ. HRME) RMESH= AMAX1( 1.01, XXX)
      IF ( HTEST.EQ. HRME) GO TO 2
      XUS= XXX
      IF ( HX.EQ. HQM) XUS= -1.
      IF ( KPCT.NE. 0.) XUS= 0.01* XUS
      GO TO 2
C:-------
 99   RETURN
C:-------
 991  WRITE( KW, 203) KR
      GO TO 999
C:-------
 203  FORMAT(/ 2X, 25HEND-OF-FILE ON INPUT UNIT, I3)
 992  WRITE( KW, 204) NQ
      GO TO 999
C:-------
 204  FORMAT(/ 2X, 3HNQ=, I3,14H  NOT ALLOWED.)
 999  CONTINUE
      WRITE( KW, 301) HTEST
 301  FORMAT( 2X, 31HERROR: CANNOT PROCESS KEYWORD  , A4)
      CALL ERROR( 0)
       NQ= 0
      GO TO 2
C:-------
C:CDC208   FORMAT( 2X, 28H OUTPUT ON LOCAL FILE   TAPE, I2)
C:-------
      END
C:****END     NEXTQ
C:****BEGIN   ERROR
      SUBROUTINE ERROR( NQ)
       Character*16 HIN
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      DATA KE/ 0/
C:BAT      GO TO 99
      IF ( NQ.EQ. -11) KE= 1
      IF ( NQ.EQ. -12) KE= 0
      IF ( NQ.EQ. -11) RETURN
      IF ( NQ.EQ. -12) RETURN
      IF ( KR.EQ. KUF( 5)) KE= 0
       KR= KUF( 5)
C:XXX
      IF ( KE.EQ. 0) RETURN
C:BAT 99   CONTINUE
      WRITE( KW, 201)
 201  FORMAT(/ 2X, 44HFATAL ERROR <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<)
      STOP 1
      END
C:****END     ERROR
C:****BEGIN   KUF(
      FUNCTION KUF( IU)
      COMMON/KUS/ KU( 10)
       KUF= KU( IU)
      RETURN
      END
C:****END     KUF(
C:****BEGIN   COND                          OMIT FROM NRLEMP
      SUBROUTINE COND( KLY)
       Character*16 HIN
      DOUBLE PRECISION HEX, HEXB, HXXX, HBLNK
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      COMMON/EXPT/ NEXPT, HEX( 30, 3), TEX( 30, 8)
      COMMON/HFS/ HFE( 3), HFA( 2)
      DIMENSION HEXB( 3), TEXB( 8), W2( 100), SP2( 100)
      DATA HBLNK/ 6H      /
C:----------
       IF ( KLY.NE. 3) KPREP= 1
 1    CONTINUE
      DO 16 I2= 1, 3
 16    HEXB( I2)= HEX( NEXPT, I2)
      DO 17 I2= 1, 8
 17    TEXB( I2)= TEX( NEXPT, I2)
C:DOC IF KLY= 3, KEYWORD IS TUBE, AND SO SKIP THE FIRST TWO DATA.
      IF ( KLY.EQ. 3) KEND= KEND+ 2
      IF ( KLY.EQ. 3) GO TO 15
      IF ( KEND.LT. 1) GO TO 998
C:
C:DOC READ X-RAY INCIDENCE ANGLE AT SAMPLE
C:SCR      READ( KS, HFE) TEXB( 1)
      DECODE( 16, HFE, HIN( IH)) TEXB( 1)
       IH= IH+ 4
      IF ( KEND.LT. 2) GO TO 20
C:DOC READ X-RAY TAKE-OFF ANGLE FROM SAMPLE
C:SCR      READ( KS, HFE) TEXB( 2)
      DECODE( 16, HFE, HIN( IH)) TEXB( 2)
       IH= IH+ 4
  15  IF ( KEND.LT. 3) GO TO 20
C:
C:DOC READ SP1 (SPECTRUM NAME, OR TUBE TARGET, OR EMITTING ELEMENT, OR
C:DOC   PHOTON WAVELENGTH, OR PHOTON ENERGY)
C:SCR      READ( KS, 701) HEXB( 1), TEXB( 3)
      DECODE( 16, 701, HIN( IH)) HEXB( 1), TEXB( 3)
       IH= IH+ 4
      IF ( KEND.LT. 4) GO TO 20
C:DOC IF SP1 IS NOT NUMERIC AND IS NOT AN ELEMENT NAME, THEN IT IS
C:DOC THE NAME OF A TABULATED SPECTRUM, AND SO SP2, SP3, AND SP4
C:DOC ARE SKIPPED OVER, AND THE NEXT DATUM IS ASSUMED TO BE SP5.
      IF ( HEXB( 1).EQ. HBLNK) GO TO 18
      CALL ZABD( NZIT, HEXB( 1), -1)
      IF ( NZIT.NE. 0) GO TO 18
      KEND= KEND+ 3
      GO TO 19
C:-------
18    CONTINUE
C:
C:DOC READ SP2 (TUBE KV, OR EMITTED LINE, OR "A", OR "KEV")
C:SCR      READ( KS, 701) HEXB( 2), TEXB( 4)
      DECODE( 16, 701, HIN( IH)) HEXB( 2), TEXB( 4)
       IH= IH+ 4
      IF ( KEND.LT. 5) GO TO 20
C:
C:DOC READ SP3 (X-RAY TAKE-OFF ANGLE FROM TUBE)
C:SCR      READ( KS, HFE) TEXB( 7)
      DECODE( 16, HFE, HIN( IH)) TEXB( 7)
      IH= IH+ 4
      TEXB( 7)= 0.017453293* TEXB( 7)
      IF ( KEND.LT. 6) GO TO 20
C:
C:DOC READ SP4 (THICKNESS OF BE WINDOW, IN MM)
C:SCR      READ( KS, HFE) TEXB( 8)
      DECODE( 16, HFE, HIN( IH)) TEXB( 8)
      IH= IH+ 4
      TEXB( 8)= TEXB( 8)* 0.185
19    IF ( KEND.LT. 7) GO TO 20
C:DOC IF KLY= 3, KEYWORD IS TUBE, SO SKIP REST OF DATA.
      IF ( KLY.EQ. 3) GO TO 20
C:
C:DOC READ SP5 (NAME OF SPECTRUM FILTER)
C:SCR      READ( KS, 181) HEXB( 3), HXXX
 181  FORMAT( A8, A8)
      DECODE( 16, 181, HIN( IH)) HEXB( 3), HXXX
       IH= IH+ 4
      IF ( HEXB( 3).EQ. HBLNK) HEXB( 3)= HXXX
      IF ( KEND.LT. 8) GO TO 20
C:
C:DOC READ SP6 (MASS-THICKNESS OF SPECTRUM ABSORBER)
C:SCR      READ( KS, HFE) TEXB( 5)
      DECODE( 16, HFE, HIN( IH)) TEXB( 5)
       IH= IH+ 4
C:DOC ALL CONDITIONS PARAMETERS HAVE BEEN READ
20    CONTINUE
      IF ( KLY.NE. 3) GO TO 30
C:MOD  BEGIN   ONLY IF X-RAY TUBE SPECTRUM IS CALCULATED
C:DOC KEYWORD IS TUBE, SO CHECK DATA AND CALL TUBE, WITH OUTPUT
      CALL ZABD( NZIT, HEXB( 1), -1)
      IF ( NZIT.EQ. 0) GO TO 991
      IF ( TEXB( 4).LE. 0.) GO TO 991
      RAD2= TEXB( 7)
      RAD1= 3.14159/ 2.- RAD2
      IF ( RAD2.GT. 3.14159/ 4.) RAD1= RAD2
      BET= TEXB( 8)
      CALL TUBE( TEXB( 4), RAD1, NZIT, RAD2, BET, NW1, W2, SP2, 1, KW)
C:MOD  END     ONLY IF X-RAY TUBE SPECTRUM IS CALCULATED
      GO TO 990
C:-------
C:DOC NOW STORE THE CONDITIONS IN THE ARRAYS HEX AND TEX
 30   IF ( KLY.EQ. 1) NEXPT= NEXPT+ 1
      IF ( KLY.EQ. 2) NEXPT= 1
      IF ( NEXPT.GT. MNY) GO TO 999
      DO 32 I2= 1, 3
 32    HEX( NEXPT, I2)= HEXB( I2)
      DO 34 I2= 1, 8
 34    TEX( NEXPT, I2)= TEXB( I2)
 998  CALL SPEC( MNW, MNY)
      IF ( NEXPT.GE. MNY) GO TO 999
 990  RETURN
C:-------
991   CONTINUE
      WRITE( KW, 604)
      GO TO 990
C:-------
604   FORMAT( 2X, 47H# TUBE TARGET AND VOLTAGE NOT PRESENTLY DEFINED)
 999  CONTINUE
      WRITE( KW, 605)
  605 FORMAT( 2X, 47HMAXIMUM NUMBER OF DIFFERENT SETS OF CONDITIONS.,
     1 / 2X, 52HYOU SHOULD USE "CONDITIONS" BEFORE ANY MORE "LINES".)
      IF ( NEXPT.GT. MNY) CALL ERROR( 0)
      NEXPT= MNY
      GO TO 990
C:----------
 701  FORMAT( A8, E8.0)
      END
C:****END     COND                          OMIT FROM NRLEMP
C:****BEGIN   SAMP
      SUBROUTINE SAMP
       Character*16 HIN
      DOUBLE PRECISION HTEST, HXXX, HSAMP, HBLNK
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/GRAIN/ TBAR( 20), DEN( 20), VVOID, TVOID
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/HFS/ HFE( 3), HFA( 2)
      DIMENSION XD1( 20), XD2( 20)
C:DIM  XD1( MNX), XD2( MNX)
      DATA HBLNK/ 6H      /
      DATA HHOM/ 3HHOM/, HPAR/ 3HPAR/, HSEP/ 3HSEP/
C:----------
       IS= JSR
      IF ( KEND.GE. 1) GO TO 23
      IF ( KEND.LT. 1) GO TO 99
 23   CONTINUE
C:SCR      READ( KS, 181) HTEST, HXXX
 181  FORMAT( A8, A8)
      DECODE( 16, 181, HIN( IH)) HTEST, HXXX
       IH= IH+ 4
      IF ( HTEST.EQ. HBLNK) HTEST= HXXX
 10   IF ( NSAM.LE. 0)  NSAM= 1
      IF ( NSAM.LT. 2) GO TO 12
      DO 11 IS= 2, NSAM
      IF ( HTEST.EQ. HSAMP( IS)) GO TO 30
 11   CONTINUE
 12   IF ( NSAM.GE. MNS) GO TO 991
       NSAM= NSAM+ 1
       NS1= NSAM
       NSTD= NS1
       KADJB= 1
       KADJY= 1
       YNOR1( NSAM)= -1.
       IS= NSAM
       HSAMP( IS)= HTEST
      DO 14 IY= 1, MNY
       YE( IS, IY)= YPAR( IY, 5)
 14    Y1( IS, IY)= -1.
       PS( IS, 1)= 0.
       PS( IS, 5)= 0.
       PS( IS, 2)= PS( 1, 2)
       PS( IS, 3)= PS( 1, 3)
       PS( IS, 4)= PS( 1, 4)
       PS( IS, 6)= PS( 1, 6)
       PS( IS, 7)= PS( 1, 7)
 30   IF ( KEND.LT. 2) GO TO 99
       KADJY= 1
       YNOR1( IS)= -1.
C:SCR      READ( KS, 182) HX
      DECODE( 16, 182, HIN( IH)) HX
       IH= IH+ 4
 182  FORMAT( A3)
      IF ( HX.EQ. HHOM) PS( IS, 2)= 2.
      IF ( HX.EQ. HPAR) PS( IS, 2)= 4.
      IF ( HX.EQ. HSEP) PS( IS, 2)= 3.
      IF ( PS( IS, 2).GT. 0.) GO TO 8
 7    CALL ERROR( 0)
      GO TO 999
C:-------
 8     KIND= PS( IS, 2)
      IF ( KEND.LT. 3) GO TO 99
C:SCR      READ( KS, HFE) PS( IS, 3)
      DECODE( 16, HFE, HIN( IH)) PS( IS, 3)
       IH= IH+ 4
      IF ( KEND.LT. 4) GO TO 99
C:SCR      READ( KS, HFE) PS( IS, 6)
      DECODE( 16, HFE, HIN( IH)) PS( IS, 6)
       IH= IH+ 4
      IF ( KEND.LT. 5) GO TO 99
C:SCR      READ( KS, HFE) PS( IS, 7)
      DECODE( 16, HFE, HIN( IH)) PS( IS, 7)
       IH= IH+ 4
       PS( IS, 7)= 0.0001* PS( IS, 7)/ 1.5
      IF ( KEND.LT. 6) GO TO 99
C:SCR      READ( KS, HFE) PS( IS, 4)
      DECODE( 16, HFE, HIN( IH)) PS( IS, 4)
       IH= IH+ 4
 99   CONTINUE
       KIND= PS( IS, 2)
       PS( 1, 2)= KIND
       PS( 1, 3)= PS( IS, 3)
       PS( 1, 4)= PS( IS, 4)
       PS( 1, 6)= PS( IS, 6)
       PS( 1, 7)= PS( IS, 7)
       THICK= PS( IS, 3)
       AREA= PS( IS, 4)
       VVOID= PS( IS, 6)
       TVOID= PS( IS, 7)
      IF ( KIND.EQ. 3) KPCT= 0
C:ALT??      IF ( KIND.NE. 3) KPCT= 1
       JSR= IS
 999  RETURN
C:-------
 991  CONTINUE
      WRITE( KW, 207) MNS
 207  FORMAT( 2X, 38HERROR: NUMBER OF SAMPLES CANNOT EXCEED, I3)
      CALL ERROR( 0)
      GO TO 999
C:-------
      END
C:****END     SAMP
C:****BEGIN   DUMPS
      SUBROUTINE DUMPS( KOND, NX, NY)
       Character*16 HIN
      DOUBLE PRECISION HXU, HEX, HSAMP, HXS, HBL6
      DOUBLE PRECISION HK, SDUMP, HTEST, HUND
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/EXPT/ NEXPT, HEX( 30, 3), TEX( 30, 8)
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMX/ HXS( 51, 20), X1( 51, 20, 2)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/GRAIN/ TBAR( 20), DEN( 20), VVOID, TVOID
      DIMENSION HK( 4), SDUMP( 6), YET( 30)
C:DIM  HK( 4), SDUMP( 6), YET( MNY)
      DIMENSION XC( 20), XG( 20)
C:DIM  XC( MNX), XG( MNX)
      DATA HK/ 8HHOMOG   , 8HHOMOG   , 8HSEPARATE, 8HPARTIC  /
      DATA HBL6/ 6H       /, HUND/ 6H------/, LINUM/ 1000/
      DATA HBLNK/ 1H /, HZERO/ 1H0/
C:-------
      IF ( KW.EQ. KUF( 6)) HC= HBLNK
      IF ( KW.NE. KUF( 6)) HC= HZERO
       LN= LINUM
       JSRT= IABS( JSR)
       IS1= JSRT
       IS2= JSRT
      IF ( KOND.EQ. 1) GO TO 14
       IS1= 2
       IS2= NS1
       LN= LN+ 10
      WRITE( KW, 400) HC, LN
       LN= LN+ 10
      WRITE( KW, 414) HC, LN
       LN= LN+ 10
      WRITE( KW, 400) HC, LN
       LN= LN+ 10
      WRITE( KW, 410) HC, LN
      DO 12 IY= 1, MNY
      IF ( NZY( IY).LE. 0) GO TO 12
      CALL ZABD( NZY( IY), HTEST, 1)
       LN= LN+ 10
      WRITE( KW, 411) HC, LN, IY, HTEST
 12   CONTINUE
       LN= LN+ 10
      WRITE( KW, 400) HC, LN
       LN= LN+ 10
      IF ( KPCT.EQ. 0) WRITE( KW, 408) HC, LN
      IF ( KPCT.NE. 0) WRITE( KW, 409) HC, LN
 14   IF ( IS1.GT. IS2) GO TO 90
      DO 80 IS= IS1, IS2
      IF ( KOND.EQ. 1) GO TO 16
      IF ( PS( IS, 5).LE. 0.) GO TO 80
 16   CONTINUE
C:ALT       KDUMP= 0
       SDUMP( 1)= HBL6
C:ALT      IF ( HSAMP( IS).NE. HBL6) KDUMP= 1
C:ALT       KDUMP= 1
       SDUMP( 1)= HSAMP( IS)
       KIND= PS( IS, 2)
       SDUMP( 2)= HK( KIND)
C:ALT      IF ( KIND.GT. 2) KDUMP= 2
       SDUMP( 3)= PS( IS, 3)
C:ALT      IF ( SDUMP( 3).LT. 100.) KDUMP= 3
       SDUMP( 4)= PS( IS, 6)
C:ALT      IF ( SDUMP( 4).NE. 0.) KDUMP= 4
       SDUMP( 5)= 10000.* PS( IS, 7)* 1.5
C:ALT      IF ( SDUMP( 5).NE. 0.) KDUMP= 5
       SDUMP( 6)= PS( IS, 4)
C:ALT      IF ( SDUMP( 6).NE. 1.) KDUMP= 6
       KCOMP= 0
      CALL XSAMP( IS+ 0, XC, XG, NX, 0)
      DO 177 IX= 1, NX
      XGIX= XG( IX)
       HTEST= HXU( IX)
       TBARIX= 10000.* TBAR( IX)* 1.5
       XUIX= XGIX
      IF ( KPCT.NE. 0.) XUIX= 100.* XUIX
      IF ( XUIX.LT. 0.) XUIX= -1.
      IF ( HTEST.EQ. HUND) GO TO 177
      IF ( XUIX.EQ. 0.) GO TO 177
      IF ( KCOMP.NE. 0) GO TO 176
       KCOMP= 1
       LN= LN+ 10
      WRITE( KW, 400) HC, LN
       LN= LN+ 10
      IF ( KOND.EQ. 1) GO TO 53
C:ALT      IF ( KOUT.EQ. 2) GO TO 53
      WRITE( KW, 401) HC, LN, SDUMP( 1)
      GO TO 176
 53   WRITE( KW, 401) HC, LN, ( SDUMP( IDUMP), IDUMP= 1, 6)
 176  CONTINUE
       LN= LN+ 10
      IF ( KPCT.NE. 0) GO TO 55
      IF ( XUIX.LT. 0.) GO TO 55
      IF ( KOND.EQ. 1) GO TO 54
C:ALT      IF ( KOUT.EQ. 2) GO TO 54
      WRITE( KW, 402) HC, LN, HTEST, XUIX
      GO TO 177
 54   IF ( TBARIX.GT. 0.) WRITE( KW, 402) HC, LN, HTEST, XUIX, TBARIX
      IF ( TBARIX.LE. 0.) WRITE( KW, 405) HC, LN, HTEST, XUIX
      GO TO 177
C:    -------
 55   CONTINUE
      IF ( KOND.EQ. 1) GO TO 56
C:ALT      IF ( KOUT.EQ. 2) GO TO 56
      WRITE( KW, 406) HC, LN, HTEST, XUIX
      GO TO 177
 56   IF ( TBARIX.GT. 0.) WRITE( KW, 406) HC, LN, HTEST, XUIX, TBARIX
      IF ( TBARIX.LE. 0.) WRITE( KW, 407) HC, LN, HTEST, XUIX
 177  CONTINUE
       KINT= 0
      IF ( KOND.EQ. 1) GO TO 178
      IF ( KCOMP.EQ. 0) GO TO 80
178   CONTINUE
      DO 60 IY= 1, MNY
      IF ( IS.EQ. IS1) YET( IY)= 0.
      IF ( NZY( IY).LE. 0) GO TO 60
      IF ( Y1( IS, IY).LT. 0.) GO TO 60
      IF ( KINT.NE. 0) GO TO 58
       KINT= 1
       LN= LN+ 10
      WRITE( KW, 400) HC, LN
       LN= LN+ 10
      IF ( KOND.EQ. 1) GO TO 57
C:ALT      IF ( KOUT.EQ. 2) GO TO 57
      WRITE( KW, 403) HC, LN, SDUMP( 1)
      GO TO 58
 57   WRITE( KW, 403) HC, LN, ( SDUMP( IDUMP), IDUMP= 1, 6)
 58    LN= LN+ 10
      KRXI= 0
C:ALT
      IF ( YE( IS, IY).GT. 0.) KRXI= 1
       YRXI= Y1( IS, IY)
      WRITE( KW, 404) HC, LN, IY, YRXI, KRXI
 60   CONTINUE
      IF ( KOUT.EQ. 1) GO TO 78
       KINT= 0
      DO 70 IY= 1, MNY
      IF ( NZY( IY).LE. 0) GO TO 70
      IF ( Y1( IS, IY).LT. 0.) GO TO 70
C:ALT     IF ( ABS( YE( IS, IY)).EQ. YET( IY)) GO TO 70
       YET( IY)= ABS( YE( IS, IY))
      IF ( KINT.NE. 0) GO TO 68
       KINT= 1
       LN= LN+ 10
      WRITE( KW, 400) HC, LN
       LN= LN+ 10
      IF ( KOND.EQ. 1) GO TO 67
C:ALT      IF ( KOUT.EQ. 2) GO TO 67
      WRITE( KW, 412) HC, LN, SDUMP( 1)
      GO TO 68
 67   WRITE( KW, 412) HC, LN, ( SDUMP( IDUMP), IDUMP= 1, 6)
 68    LN= LN+ 10
      WRITE( KW, 413) HC, LN, IY, YET( IY)
 70   CONTINUE
 78    LN= LN+ 10
      WRITE( KW, 400) HC, LN
 80   CONTINUE
 90    LN= LN+ 10
      WRITE( KW, 400) HC, LN
C:ALT      IF ( KW.NE. KUF( 6)) LINUM= LN
       LINUM= LN
      RETURN
C:-------
 400  FORMAT( A1, I4, 2X, 1H )
 401  FORMAT( A1, I4, 2X, 11HCOMPOSITION, 1X, A8, 1X, A8,
     1  1X, F9.4, 1X, F7.4, 1X, F8.2, 1X, F8.4)
 402  FORMAT( A1, I4, 2X, 1X, A8, 1X, E14.5, 1X, F9.2)
 403  FORMAT( A1, I4, 2X, 11HINTENSITIES , 1X, A8, 1X, A8,
     1  1X, F9.4, 1X, F7.4, 1X, F8.2, 1X, F8.4)
 404  FORMAT( A1, I4, 2X, I2, E14.5, I3)
 405  FORMAT( A1, I4, 2X, 1X, A8, 1X, E14.5, 2X, 1H0)
 406  FORMAT( A1, I4, 2X, 1X, A8, 1X, F9.4, 1X, F9.2)
 407  FORMAT( A1, I4, 2X, 1X, A8, 1X, F9.4, 2X, 1H0)
 408  FORMAT( A1, I4, 2X, 6HNO PCT)
 409  FORMAT( A1, I4, 2X, 3HPCT)
 410  FORMAT( A1, I4, 2X, 5HLINES)
 411  FORMAT( A1, I4, 2X, I2, 1X, A8)
 412  FORMAT( A1, I4, 2X, 11HERRORS      , 1X, A8, 1X, A8,
     1  1X, F9.4, 1X, F7.4, 1X, F8.2, 1X, F8.4)
 413  FORMAT( A1, I4, 2X, I2, 1X, 2PF9.4)
 414  FORMAT( A1, I4, 2X, 9HEMPIRICAL)
      END
C:****END     DUMPS
C:****BEGIN   SNORM                         OMIT FROM NRLEMP
      SUBROUTINE SNORM( NX, NY, NEL, JZY)
       Character*16 HIN
      DOUBLE PRECISION HSAMP, HXU, HXS, HTST, HALL
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/HFS/ HFE( 3), HFA( 2)
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/GRAIN/ TBAR( 20), DEN( 20), VVOID, TVOID
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMX/ HXS( 51, 20), X1( 51, 20, 2)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
      COMMON/YNORC/ YNOR( 51, 30)
      DIMENSION JZY( NY)
      DIMENSION YSIM( 30), CC( 20), XC( 20), XG( 20)
      DATA HALL/ 6HALL   /
C:----------
      IF ( NY.LE. 0) GO TO 90
       KALL= 0
      IF ( KEND.LT. 1) GO TO 88
C:SCR      READ( KS, HFA) HTST
      DECODE( 16, HFA, HIN( IH)) HTST
      IF ( HTST.NE. HALL) GO TO 88
      DO 80 IY= 1, NY
80     YN( IY)= 0.
      GO TO 99
C:    -------
 88   CONTINUE
      CALL IN( KR, 40, 2, KEND, HIN)
       IH= 1
      IF ( KEND.LT. 1) GO TO 99
C:SCR      READ( KS, HFE) XXX
      DECODE( 16, HFE, HIN( IH)) XXX
       IH= IH+ 4
       KEND= KEND- 1
       IY= XXX
      IF ( KEND.GT. 0) GO TO 86
      IF ( KALL.NE. 0) GO TO 87
      GO TO 89
86    CONTINUE
C:SCR      READ( KS, HFA) HTST
      DECODE( 16, HFA, HIN( IH)) HTST
      IF ( HTST.NE. HALL) GO TO 89
       KALL= 1
87     YN( IY)= 0.
      GO TO 88
C:    -------
 89   CALL SAMP
       KALL= 0
      IF ( Y1( JSR, IY).LE. 0.) GO TO 93
      IF ( NX.GT. 0) GO TO 172
       YN( IY)= 0.
      GO TO 88
C:-------
172   CONTINUE
      IF ( KPREP.NE. 0) KADJY= 2
      IF ( KADJY.NE. 0) CALL YNORM( NX, NY, NEL, JZY)
       YN( IY)= JSR
      CALL XSAMP( JSR, XC, XG, NX, 1)
      IF ( YNOR( JSR, IY).LE. 0.) GO TO 95
      GO TO 88
C:    -------
 90   WRITE( KW, 201)
 201  FORMAT( 2X, 26H ERROR: LINES NOT DEFINED.)
      GO TO 98
 93   WRITE( KW, 204) IY, HSAMP( JSR)
 204  FORMAT( 2X, 29H ERROR: NO INTENSITY FOR LINE, I3, 4H IN , A10)
      GO TO 98
 95   WRITE( KW, 206) IY, HSAMP( JSR)
 206  FORMAT( 2X, 29H ERROR: CALC. RXI= 0 FOR LINE, I3, 4H IN , A10)
 98   CONTINUE
      CALL ERROR( 0)
 99   CONTINUE
      RETURN
      END
C:****END     SNORM                         OMIT FROM NRLEMP
C:****BEGIN   MEAS
      SUBROUTINE MEAS( NQ, NY)
       Character*16 HIN
      DOUBLE PRECISION HSAMP
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/HFS/ HFE( 3), HFA( 2)
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
C:----------
      IF ( NQ.EQ. 35) GO TO 20
      CALL SAMP
      IF ( JSR.LE. 0) GO TO 99
       KADJY= 1
      YNOR1( JSR)= -1.
 10   CALL IN( KR, 7, 2, KEND, HIN)
       IH= 1
      IF ( KEND.LT. 1) GO TO 99
C:SCR      READ( KS, HFE) XXX
      DECODE( 16, HFE, HIN( IH)) XXX
       IH= IH+ 4
       IY= XXX
       KEND= KEND- 1
      IF ( NQ.EQ. 33) Y1( JSR, IY)= -1.
      IF ( KEND.LT. 1) GO TO 10
C:SCR      READ( KS, HFE) YTOT
      DECODE( 16, HFE, HIN( IH)) YTOT
       IH= IH+ 4
      IF ( NQ.EQ. 37) YPAR( IY, 5)= YTOT/ 100.
      IF ( NQ.EQ. 37) GO TO 7
      IF ( KEND.LT. 2) GO TO 7
C:SCR      READ( KS, HFE) YPAR( IY, 1)
      DECODE( 16, HFE, HIN( IH)) YPAR( IY, 1)
       IH= IH+ 4
      IF ( KEND.LT. 3) GO TO 7
C:SCR      READ( KS, HFE) YPAR( IY, 2)
      DECODE( 16, HFE, HIN( IH)) YPAR( IY, 2)
       IH= IH+ 4
      IF ( KEND.LT. 4) GO TO 7
C:SCR      READ( KS, HFE) YPAR( IY, 3)
      DECODE( 16, HFE, HIN( IH)) YPAR( IY, 3)
       IH= IH+ 4
      IF ( KEND.LT. 5) GO TO 7
C:SCR      READ( KS, HFE) YPAR( IY, 4)
      DECODE( 16, HFE, HIN( IH)) YPAR( IY, 4)
       IH= IH+ 4
       YPAR( IY, 4)= 1.E-6* YPAR( IY, 4)
 7    CONTINUE
      IF ( YPAR( IY, 5).EQ. 0.) YPAR( IY, 5)= 0.0001
      IF ( YPAR( IY, 1).EQ. 0.) YPAR( IY, 5)= - ABS( YPAR( IY, 5))
      IF ( YPAR( IY, 1).NE. 0.) YPAR( IY, 5)=   ABS( YPAR( IY, 5))
      IF ( YE( JSR, IY).EQ. 0.) YE( JSR, IY)= YPAR( IY, 5)
      IF ( NQ.EQ. 37) YE( JSR, IY)= YPAR( IY, 5)
      IF ( YPAR( IY, 1).EQ. 0.) YE( JSR, IY)= - ABS( YE( JSR, IY))
      IF ( YPAR( IY, 1).NE. 0.) YE( JSR, IY)=   ABS( YE( JSR, IY))
      IF ( NQ.EQ. 37) GO TO 10
      IF ( YPAR( IY, 1).EQ. 0.) Y1( JSR, IY)= YTOT
      IF ( YPAR( IY, 1).EQ. 0.) GO TO 10
       YTOT= YTOT/ YPAR( IY, 1)
       YBKG= 0.
      IF( YPAR( IY, 2).NE. 0.) YBKG= YPAR( IY, 2)/ YPAR( IY, 3)
       YTOT= YTOT/( 1.- YTOT* YPAR( IY, 4))
     1     - YBKG/( 1.- YBKG* YPAR( IY, 4))
      IF ( YTOT.LT. 0.) YTOT= 0.
       Y1( JSR, IY)= YTOT* YPAR( IY, 7)
      GO TO 10
C:-------
 20   CONTINUE
      IF ( KEND.LT. 1) GO TO 99
C:SCR      READ( KS, HFE) ( YPAR( IY, 7), IY= 1, KEND)
      DO 22 IY= 1, KEND
      DECODE( 16, HFE, HIN( IH)) YPAR( IY, 7)
 22    IH= IH+ 4
      DO 21 IY= KEND, MNY
 21    YPAR( IY, 7)= YPAR( KEND, 7)
 99   RETURN
      END
C:****END     MEAS
C:****BEGIN   XSAMP
      SUBROUTINE XSAMP( IS, XC, XG, NX, KERR)
       Character*16 HIN
      DOUBLE PRECISION HSAMP, HXS, HXU, HXTST, HUND
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/GRAIN/ TBAR( 20), DEN( 20), VVOID, TVOID
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMX/ HXS( 51, 20), X1( 51, 20, 2)
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
      DIMENSION XC( NX), XG( NX)
      DATA HUND/ 6H------/
C:----------
      DO 177 IX= 1, NX
       HXTST= HXU( IX)
       IXS2= PS( IS, 1)
      IF ( IXS2.GT. 0) GO TO 172
       XG( IX)= -1.
 171   TBAR( IX)= TBAR1( IX)
       DEN( IX)= DEN1( IX)
      GO TO 175
C:    -------
 172  DO 173 IXS= 1, IXS2
      IF ( HXS( IS, IXS).EQ. HXTST) GO TO 174
 173  CONTINUE
       XG( IX)= 0.
      GO TO 171
C:    -------
 174   XG( IX)= X1( IS, IXS, 1)
       TBAR( IX)= X1( IS, IXS, 2)
       DEN( IX)= DEN1( IX)
 175  CONTINUE
      IF ( HXTST.EQ. HUND) XG( IX)= 0.
       XC( IX)= XG( IX)
      IF ( XC( IX).LT. 0.) XC( IX)= 0.
 177  CONTINUE
       KIND= PS( IS, 2)
       THICK= PS( IS, 3)
       AREA= PS( IS, 4)
       VVOID= PS( IS, 6)
       TVOID= PS( IS, 7)
      IF ( KERR.EQ. 0) GO TO 99
       KUNK= 0
      DO 94 IX= 1, NX
      IF ( XC( IX).GE. 0.) GO TO 94
      WRITE( KW, 205) HXU( IX), HSAMP( IS)
       KUNK= 1
94    CONTINUE
 205  FORMAT( 2X, 27H ERROR: UNKNOWN AMOUNT FOR , A10, 4H IN , A10)
      IF ( KUNK.NE. 0) CALL ERROR( 0)
99    CONTINUE
      RETURN
      END
C:****END     XSAMP
C:****BEGIN   YNORM                         OMIT FROM NRLEMP
      SUBROUTINE YNORM( NX, NY, NEL, JZY)
       Character*16 HIN
      DOUBLE PRECISION HSAMP
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/YNORC/ YNOR( 51, 30)
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
      COMMON/LMC/ PURE( 30), ROMZ( 30), YY( 30)
      DIMENSION JZY( NY)
      DIMENSION YSIM( 30), CC( 20), XC( 20), XG( 20)
C:DIM  YSIM( MNY), CC( NX), XC( MNX), XG( MNX)
C:----------
      IF ( NS1.LE. 1) GO TO 49
      DO 29 IS= 2, NS1
      IF ( KADJY.GT. 1) YNOR1( IS)= -1.
      IF ( YNOR1( IS).GE. 0.) GO TO 29
      IF ( PS( IS, 5).LE. 0.) GO TO 29
       KNZ= 0
      DO 23 IY= 1, NY
      IF ( Y1( IS, IY).GE. 0.) KNZ= 1
   23 CONTINUE
       YNOR1( IS)= 0.
      IF ( KNZ.EQ. 0) GO TO 29
C:BUG      WRITE( 6, *) IS
      CALL XSAMP( IS+ 0, XC, XG, NX, 0)
      IF ( KIND.NE. 3) CALL NORM( XC, NX, 1., XMULT)
      CALL XTOC( CC, NEL, XC, NX)
      CALL SIM( XC, NX, YSIM, NY, CC, NEL)
      YNOR1( IS)= 0.
      DO 25 IYS= 1, NY
       YNOR( IS, IYS)= 0.
      IF ( Y1( IS, IYS).LE. 0.) GO TO 25
       IZ= JZY( IYS)
       YSIMS= CC( IZ)* YSIM( IYS)
      IF ( KIND.NE. 3) YSIMS= YSIMS/ XMULT
      IF ( KIND.EQ. 3) YSIMS= YSIMS/ PURE( IYS)
24    IF ( YSIMS.NE. 0.) YNOR( IS, IYS)= Y1( IS, IYS)/ YSIMS
25    CONTINUE
C:BUG      WRITE( 6, *) ( YNOR( IS, IYS), IYS= 1, NY)
29    CONTINUE
49     KADJY= 0
      RETURN
      END
C:****END     YNORM                         OMIT FROM NRLEMP
C:****BEGIN   COMP
      SUBROUTINE COMP( NX, NEL)
       Character*16 HIN
      DOUBLE PRECISION HTEST, HSAMP, HXS, HXU, HUND, HBLNK
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMX/ HXS( 51, 20), X1( 51, 20, 2)
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/HFS/ HFE( 3), HFA( 2)
      DIMENSION NZC( 20), CC( 20)
C:DIM  NZC( MNEL), CC( MNEL)
      DATA HUND/ 6H------/, HBLNK/ 6H      /
      DATA HQM/ 3H?  /
C:----------
       KJSR= JSR
       JSR= IABS( JSR)
      IF ( JSR.LE. 0) GO TO 9
       KADJY= 1
       YNOR1( JSR)= -1.
      IF ( KJSR.LT. 0) GO TO 80
       X1TOT= 0.
       NCOMP= 0
       PS( JSR, 5)= 1.
 3    CALL IN( KR, 4, 2, KEND, HIN)
       IH= 1
      IF ( KEND.LT. 1) GO TO 6
       NCOMP= NCOMP+ 1
      IF ( NCOMP.GT. MNX) GO TO 99
C:SCR      READ( KS, 181) HXS( JSR, NCOMP), HTEST
 181  FORMAT( A8, A8)
      DECODE( 16, 181, HIN( IH)) HXS( JSR, NCOMP), HTEST
       IH= IH+ 4
      IF ( HXS( JSR, NCOMP).EQ. HBLNK) HXS( JSR, NCOMP)= HTEST
      IF ( KEND.LT. 2) GO TO 4
C:SCR      READ( KS, 183) HX, X1( JSR, NCOMP, 1)
 183  FORMAT( A1, E15.0)
      DECODE( 16, 183, HIN( IH)) HX, X1( JSR, NCOMP, 1)
       IH= IH+ 4
      IF ( KPCT.NE. 0) X1( JSR, NCOMP, 1)= 0.01* X1( JSR, NCOMP, 1)
      IF ( HX.EQ. HQM) X1( JSR, NCOMP, 1)= -1.
 4    IF ( KEND.LT. 2) X1( JSR, NCOMP, 1)= -1.
       XTEST= X1( JSR, NCOMP, 1)
      IF ( XTEST.LT. 0.) PS( JSR, 5)= -1.
      IF ( XTEST.GT. 0.) X1TOT= X1TOT+ XTEST
      IF ( KEND.LT. 3) X1( JSR, NCOMP, 2)= -1.
      IF ( KEND.LT. 3) GO TO 3
C:SCR      READ( KS, HFE) X1( JSR, NCOMP, 2)
      DECODE( 16, HFE, HIN( IH)) X1( JSR, NCOMP, 2)
       IH= IH+ 4
       X1( JSR, NCOMP, 2)= 0.0001* X1( JSR, NCOMP, 2)/ 1.5
      GO TO 3
C:-------
C:DOC  PS( JSR, 5).EQ. 0.  IF NO COMPONENT AMOUNT GIVEN
C:DOC  PS( JSR, 5).LT. 0.  IF SOME AMOUNTS GIVEN AND SOME UNKNOWN
C:DOC  PS( JSR, 5).GT. 0.  , EQUALS TOTAL COMPOSITION, IF COMPLETE
 6    CONTINUE
      IF ( NCOMP.LT. 1) PS( JSR, 5)= 0.
      IF ( NCOMP.LT. 1) GO TO 30
      IF ( X1TOT.LE. 0.) PS( JSR, 5)= 0.
      IF ( PS( JSR, 5).GT. 0.) PS( JSR, 5)= X1TOT
      DO 29 IXS= 1, NCOMP
       HTEST= HXS( JSR, IXS)
      IF ( NX.LT. 1) GO TO 27
      DO 20 IX= 1, NX
      IF ( HTEST.EQ. HXU( IX)) GO TO 28
   20 CONTINUE
      DO 24 IX= 1, NX
      IF ( HXU( IX).EQ. HUND) GO TO 31
   24 CONTINUE
 27    NX= NX+ 1
       IX= NX
 31    KPREP= 1
       HXU( IX)= HTEST
      DO 26 IZ= 1, MNEL
   26  PELC( IZ, IX)= 0.
       DEN1( IX)= 0.
      CALL  DEFD( HTEST, DEN1( IX), NOZC, NZC, CC, MNEL, KUF( 3))
      IF ( NOZC.LE. 0) GO TO 29
      DO 23 K= 1, NOZC
      IF ( NEL.EQ. 0) GO TO 22
      DO 21 IZ= 1, NEL
      IF ( NZC( K).EQ. NZEL( IZ)) GO TO 23
   21 CONTINUE
 22    NEL= NEL+ 1
      IF ( NEL.LE. MNEL) GO TO 25
      WRITE( KW, 210) MNEL
 210  FORMAT( 2X, 38H ERROR: THE SAMPLES INCLUDE MORE THAN
     1 , I2, 20H DIFFERENT ELEMENTS.)
      CALL ERROR( 0)
      GO TO 9
C:    -------
 25    NZEL( NEL)= NZC( K)
       IZ= NEL
 23    PELC( IZ, IX)= CC( K)
 28   CONTINUE
      IF ( X1( JSR, IXS, 2).LT. 0.) X1( JSR, IXS, 2)= TBAR1( IX)
       TBAR1( IX)= X1( JSR, IXS, 2)
 29   CONTINUE
      GO TO 30
C:-------
C:DOC FOR DEFINING THE COMPONENTS TO BE THE EMITTING ELEMENTS,
C:DOC   AS FOR "ANALYZE" WHEN THERE WAS NO PREVIOUS "COMPOSITION".
 80   CONTINUE
       NCOMP= NX
      IF ( NX.GT. 0) GO TO 30
       PS( JSR, 5)= 0.
       NX= NEL
       KPREP= 1
      DO 84 IX= 1, NX
      DO 82 IZ= 1, MNEL
   82  PELC( IZ, IX)= 0.
       PELC( IX, IX)= 1.
       DEN1( IX)= 0.
       TBAR1( IX)= 0.
       X1( JSR, IX, 1)= -1.
       X1( JSR, IX, 2)= 0.
      CALL ZABD( NZEL( IX), HXS( JSR, IX), 1)
       HXU( IX)= HXS( JSR, IX)
 84   CONTINUE
       NCOMP= NX
 30    PS( JSR, 1)= NCOMP
 9    RETURN
C:-------
 99   CONTINUE
      CALL ERROR( 0)
       NCOMP= NCOMP- 1
      GO TO 9
      END
C:****END     COMP
C:****BEGIN   SPEC                          OMIT FROM NRLEMP
      SUBROUTINE SPEC( MNW, MNY)
       Character*16 HIN
      DOUBLE PRECISION HSP, H1, H2, HTEMP, HEX, HNONE, HFILT, HDONE
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/HFS/ HFE( 3), HFA( 2)
      COMMON/SPEC1/ NW1, W1( 300), SP1( 300), JSP1( 31), NSP
      COMMON/EXPT/ NEXPT, HEX( 30, 3), TEX( 30, 8)
      DIMENSION HSP( 30, 3), FHSP1( 30), FHSP2( 30), TFSP( 30), ASP( 30)
C:DIM  HSP( MNY, 3), FHSP1( MNY), FHSP2( MNY), TFSP( MNY), ASP( MNY)
      DIMENSION BETSP( 30)
C:DIM  BETSP( MNY)
      DATA HTEMP/ 6HTEMP  /, HNONE/ 6HNONE  /, HDONE/ 6H0000  /
C:----------
      IF ( NSP.GE. MNY)  NSP= 0
      IF ( NSP.LT. 0) NSP= 0
      IF ( NEXPT.EQ. 1) NSP= 0
      DO 48 IEXPT= 1, NEXPT
      IF ( HEX( IEXPT, 1).EQ. HNONE) GO TO 48
      IF ( HEX( IEXPT, 1).EQ. HDONE) GO TO 48
      IF ( NSP.LE. 0) III= 0
      IF ( NSP.LE. 0) GO TO 43
      IF ( HEX( IEXPT, 1).EQ. HTEMP) GO TO 43
      DO 42 ISP= 1, NSP
      IF ( HSP( ISP, 1).NE. HEX( IEXPT, 1)) GO TO 42
      IF ( HSP( ISP, 2).NE. HEX( IEXPT, 2)) GO TO 42
      IF ( HSP( ISP, 3).NE. HEX( IEXPT, 3)) GO TO 42
      IF ( FHSP1( ISP).NE. TEX( IEXPT, 3)) GO TO 42
      IF ( FHSP2( ISP).NE. TEX( IEXPT, 4)) GO TO 42
      IF ( TFSP( ISP).NE. TEX( IEXPT, 5)) GO TO 42
      IF ( ASP( ISP).NE. TEX( IEXPT, 7)) GO TO 42
      IF ( BETSP( ISP).NE. TEX( IEXPT, 8)) GO TO 42
       TEX( IEXPT, 6)= ISP
C:BUG      WRITE( 6, *) IEXPT, ISP
      GO TO 48
   42 CONTINUE
      IF ( NEXPT.EQ. 1) NSP= 0
      IF ( NSP.LE. 0) III= 0
 43    NSP= NSP+ 1
      IF ( NSP.GT. MNY) GO TO 49
       HSP( NSP, 1)= HEX( IEXPT, 1)
       HSP( NSP, 2)= HEX( IEXPT, 2)
       HSP( NSP, 3)= HEX( IEXPT, 3)
       FHSP1( NSP)= TEX( IEXPT, 3)
       FHSP2( NSP)= TEX( IEXPT, 4)
       TFSP( NSP)= TEX( IEXPT, 5)
       TEX( IEXPT, 6)= NSP
C:BUG      WRITE( 6, *) IEXPT, NSP
C:BUG      WRITE( 6, *) ( TEX( IEXPT, IJK), IJK= 1, 8)
      ASP( NSP)= TEX( IEXPT, 7)
      BETSP( NSP)= TEX( IEXPT, 8)
      GO TO 7
 49   WRITE( KW, 208) MNY
 208  FORMAT( 2X, 33H THE NO. OF SPECTRA MUST BE: 1--, I2)
      CALL ERROR( 0)
       NSP= -1
      RETURN
C:-------
 7    CONTINUE
       H1= HSP( NSP, 1)
       H2= HSP( NSP, 2)
       F1= FHSP1( NSP)
       F2= FHSP2( NSP)
      IF ( H1.NE. HTEMP) GO TO 5
      CALL IN( KR, 1, 2, KEND, HIN)
       IH= 1
C:SCR      READ( KS, HFE) XXX
      DECODE( 16, HFE, HIN( IH)) XXX
       IH= IH+ 4
       NW1= XXX
      IF (( III+ NW1).LE. MNW) GO TO 3
 6    WRITE( KW, 207) MNW
 207  FORMAT( 2X, 14H NO MORE THAN , I3, 19H INTERVALS ALLOWED.)
       NW1= - III
       NSP= NSP- 1
      CALL ERROR( 0)
      RETURN
C:-------
 3    CONTINUE
      CALL IN( KR, 2* NW1, 2, KEND, HIN)
       IH= 1
      IF ( KEND.LT. 2* NW1) NW1= KEND/ 2
       IW1= III+ 1
       IW2= III+ NW1
C:SCR      READ( KS, HFE) ( W1( IW), SP1( IW), IW= IW1, IW2)
      DO 31 IW= IW1, IW2
      DECODE( 16, HFE, HIN( IH)) W1( IW)
       IH= IH+ 4
      DECODE( 16, HFE, HIN( IH)) SP1( IW)
 31    IH= IH+ 4
       HSP( NSP, 1)= HDONE
       HEX( IEXPT, 1)= HDONE
      GO TO 601
C:-------
 5    CONTINUE
      F3= ASP( NSP)
      F4= BETSP( NSP)
      CALL  SPIN( H1, F1, H2, F2, F3, F4, III, KSP, NW1, W1, SP1, MNW)
      IF ( KSP.EQ. 0) GO TO 601
      IF ( KSP.EQ. -2) GO TO 50
      WRITE( KW, 211) H1, F1, H2, F2
 40   CALL ERROR( 0)
      GO TO 48
C:-------
 50   WRITE( KW, 207) MNW
      GO TO 40
C:-------
 601   JSP1( NSP)= III
       III= III+ NW1
       NW1= III
       JSP1( NSP+ 1)= NW1
       TFN= TFSP( NSP)
       HFILT= HSP( NSP, 3)
       IW1= JSP1( NSP)+ 1
       IW2= JSP1( NSP+ 1)
      IF ( TFN.EQ. 0.) GO TO 47
      KCONT= 0
      DO 10 IW= IW1, IW2
      IF ( SP1( IW).EQ. 0.) KCONT= 1
      CON= EXP2F( -23., - TFN* CMACF( HFILT, W1( IW), 1, KMAC))
      IF ( KCONT.NE. 0) SP1( IW)= SP1( IW)* CON
      IF ( KCONT.NE. 0) GO TO 10
      IF ( CON.NE. 0.) SP1( IW)= SP1( IW)* CON
      IF ( CON.EQ. 0.) SP1( IW)= - SP1( IW)
10    CONTINUE
 47   CONTINUE
C:BUG
C:BUG      WRITE( 6, *) IEXPT, NSP, JSP1( NSP), NW1
C:BUG
C:BUG      WRITE( KW, *) ( W1( IW), SP1( IW), IW= IW1, IW2)
 48   CONTINUE
      RETURN
C:-------
 211  FORMAT( 2X, 22HSPECTRUM NOT FOUND:   , A10, F10.4, A10, F10.4)
      END
C:****END     SPEC                          OMIT FROM NRLEMP
C:****BEGIN   MAC                           OMIT FROM NRLEMP
      SUBROUTINE MAC
       Character*16 HIN
      DOUBLE PRECISION H1, H2, HFILT, HXXX, HBLNK, HKEV, HANG
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      DATA HBLNK/ 6H      /, HKEV/ 6HKEV   /, HANG/ 6HA     /
C:-------
      IF ( KEND.LT. 1) GO TO 99
C:SCR      READ( KS, 181) HFILT, HXXX
 181  FORMAT( A8, A8)
      DECODE( 16, 181, HIN( IH)) HFILT, HXXX
       IH= IH+ 4
      IF ( HFILT.EQ. HBLNK) HFILT= HXXX
      IF ( KEND.LT. 2) GO TO 20
C:SCR      READ( KS, 701) H1, F1
      DECODE( 16, 701, HIN( IH)) H1, F1
       IH= IH+ 4
      IF ( KEND.LT. 3) GO TO 20
C:SCR      READ( KS, 701) H2
      DECODE( 16, 701, HIN( IH)) H2
       IH= IH+ 4
 701  FORMAT( A8, E8.0)
 20   IF ( H2.EQ. HKEV) GO TO 6
      IF ( H2.EQ. HANG) GO TO 6
      CALL ZABD( NZI, H1, -1)
      IF ( NZI.LE. 0) GO TO 99
       JLINE= JLDF( H2)
      IF ( JLINE.LE. 0) GO TO 99
       W1= WLF( NZI, JLINE)
      GO TO 601
C:-------
 6    CONTINUE
      IF ( F1.LE. 0.) GO TO 99
      IF ( H2.EQ. HKEV) W1= 12.398/ F1
      IF ( H2.EQ. HANG) W1= F1
 601  CONTINUE
        ABSC= CMACF( HFILT, W1, 1, KMAC)
      WRITE( KW, 702) ABSC
 702  FORMAT( 2X, F10.4)
 99   RETURN
C:-------
      END
C:****END     MAC                           OMIT FROM NRLEMP
C:****BEGIN   DEFIN
      SUBROUTINE DEFIN( NX, NEL)
       Character*16 HIN
      DOUBLE PRECISION HT, HXU, HE, HEND, HUND, HT2, HBLNK, HT4, HT5
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/HFS/ HFE( 3), HFA( 2)
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
      DIMENSION HE( 20)
C:DIM  HE( NO. OF ELEMENTS PER COMPONENT)
      DIMENSION NZC( 20), CC( 20)
C:DIM  NZC( MNEL), CC( MNEL)
      DATA HATOM/ 1HA/, HMASS/ 1HM/, HEND/ 6HEND   /, HEQ/ 3HEQ /
      DATA HUND/ 6H------/, HBLNK/ 6H      /
C:----------
      IF ( KEND.LT. 1) GO TO 99
       KDEF= 1
       NEX= 0
C:SCR      READ( KS, 181) HT, HT2
 181  FORMAT( A8, A8)
      DECODE( 16, 181, HIN( IH)) HT, HT2
       IH= IH+ 4
      IF ( HT.EQ. HBLNK) HT= HT2
       KEND= KEND- 1
      IF ( KEND.LT. 1) KDEF= -1
      IF ( KDEF.LT. 0) KADJB= 1
       IX= 1
      IF ( NX.LE. 0) NX= 0
      IF ( NX.EQ. 0) GO TO 43
      DO 40 IX= 1, NX
      IF ( HXU( IX).EQ. HT) GO TO 44
   40 CONTINUE
      IF ( KDEF.LT. 0) GO TO 99
       KPREP= 1
      DO 42 IX= 1, NX
      IF ( HXU( IX).EQ. HUND) GO TO 44
   42 CONTINUE
 43    NX= NX+ 1
       IX= NX
 44   CONTINUE
       HXU( IX)= HT
       DEN1( IX)= 0.
C:XXX
      IF ( KDEF.LT. 0) HXU( IX)= HUND
      IF ( KEND.LT. 1) GO TO 45
C:SCR      READ( KS, 707) HT3, DEN1( IX)
      DECODE( 16, 707, HIN( IH)) HT3, DEN1( IX)
       IH= IH+ 4
 707  FORMAT( A2, 6X, E8.0)
       KEND= KEND- 1
      IF ( HT3.EQ. HEQ) GO TO 80
      IF ( KEND.LT. 1) GO TO 99
       NEX= 0
      CALL ZABD( NZI, HT, -1)
      IF ( NZI.EQ. 0) GO TO 3
       NEX= 1
       NZC( 1)= NZI
       CC( 1)= 1.0
      DO 49 IEL= 1, MNEL
   49  PELC( IEL, IX)= 0.
       KPREP= 1
      GO TO 19
C:-------
 3    CONTINUE
C:SCR      READ( KS, 183) HAM
      DECODE( 16, 183, HIN( IH)) HAM
  183 FORMAT( A1)
       NEX= 0
 47   CALL IN( KR, 2, 2, KEND, HIN)
      IF ( KEND.LT. 2) GO TO 51
       NEX= NEX+ 1
      IF ( NEX.GT. MNEL) GO TO 15
C:SCR      READ( KS, HFA) HE( NEX)
      DECODE( 16, HFA, HIN( 1)) HE( NEX)
C:SCR      READ( KS, HFE) CC( NEX)
      DECODE( 16, HFE, HIN( 5)) CC( NEX)
C:XXX
      GO TO 47
 702  FORMAT( A8/ E16.0)
 51   IF ( NEX.LT. 1) KDEF= -1
      IF ( NEX.LT. 1) GO TO 44
 45   DO 46 IEL= 1, MNEL
   46  PELC( IEL, IX)= 0.
       KPREP= 1
      IF ( KDEF.LT. 0) GO TO 98
      DO 14 IEX= 1, NEX
      CALL ZABD( NZC( IEX), HE( IEX), -1)
      IF ( NZC( IEX).LE. 0) GO TO 17
 14   CONTINUE
      GO TO 19
C:-------
 15   WRITE( KW, 205) HT, MNEL
 205  FORMAT( 2X, A10, 15H HAS MORE THAN , I2, 11H ELEMENTS. )
      GO TO 18
C:-------
 17   WRITE( KW, 202) HE( IEX)
 18   CALL ERROR( 0)
       KDEF= -1
      GO TO 44
C:-------
 19    S= 0.
      DO 27 IEX= 1, NEX
      IF ( HAM.EQ. HATOM) CC( IEX)= CC( IEX)* ATWTF( NZC( IEX))
 27    S= S+ CC( IEX)
      IF ( S.NE. 0.) S= 1./ S
      DO 28 IEX= 1, NEX
 28    CC( IEX)= S* CC( IEX)
      DO 23 K= 1, NEX
      IF ( NEL.EQ. 0) GO TO 22
      DO 21 IZ= 1, NEL
      IF ( NZC( K).EQ. NZEL( IZ)) GO TO 23
 21   CONTINUE
 22    NEL= NEL+ 1
      IF ( NEL.LE. MNEL) GO TO 25
      WRITE( KW, 210) MNEL
 210  FORMAT( 2X, 38H ERROR: THE SAMPLES INCLUDE MORE THAN
     1 , I2, 20H DIFFERENT ELEMENTS.)
      CALL ERROR( 0)
       KDEF= -1
       NEL= NEL- 1
      GO TO 44
C:    -------
 25    NZEL( NEL)= NZC( K)
       IZ= NEL
 23    PELC( IZ, IX)= CC( K)
 98   CONTINUE
      IF ( KDEF.GT. 0) GO TO 99
      IF ( IX.EQ. NX) NX= NX- 1
 99   RETURN
C:-------
 101  FORMAT( 6X, A8)
 202  FORMAT( 2X, A2, 17H NOT AN ELEMENT. )
C:-------
 80   CONTINUE
C:SCR      READ( KS, 181)  HT4, HT5
      DECODE( 16, 181, HIN( IH)) HT4, HT5
       IH= IH+ 4
      IF ( HT4.EQ. HBLNK) HT4= HT5
       KEND= KEND- 1
      DO 82 IX2= 1, NX
      IF ( HXU( IX2).EQ. HT4) GO TO 86
   82 CONTINUE
      CALL  DEFD( HT4, DEN1( IX), NEX, NZC, CC, MNEL, KUF( 3))
      IF ( NEX.GT. MNEL) GO TO 15
      IF ( NEX.LT. 1) GO TO 84
      DO 83 IEX= 1, NEX
   83 CALL ZABD( NZC( IEX), HE( IEX), 1)
      GO TO 51
C:-------
 84   WRITE( KW, 211) HT4, HT
 211  FORMAT( 2X, A8, 12H NOT FOUND; , A8, 13H NOT DEFINED.)
       HXU( IX)= HUND
       KDEF= -1
      GO TO 45
C:-------
 86   CONTINUE
      DO 88 IEL= 1, MNEL
   88  PELC( IEL, IX)= PELC( IEL, IX2)
       DEN1( IX)= DEN1( IX2)
       TBAR1( IX)= TBAR1( IX2)
      GO TO 99
C:-------
      END
C:****END     DEFIN
C:****BEGIN   LINE
      SUBROUTINE LINE( KLY, NY, NEL)
       Character*16 HIN
      DOUBLE PRECISION HZY, HEX, HXX, HBLNK
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/HFS/ HFE( 3), HFA( 2)
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
C:MOD  BEGIN                                OMIT FROM NRLEMP
      COMMON/EXPT/ NEXPT, HEX( 30, 3), TEX( 30, 8)
C:MOD  END                                  OMIT FROM NRLEMP
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
      COMMON/CSCS/ CSC1( 30), CSC2( 30)
      DIMENSION HZY( 30)
C:DIM  HZY( MNY)
      DATA HBLNK/ 6H      /
C:XXX
      DIMENSION HLIN1( 11), HLIN2( 11)
C:DIM  HLIN1( 11), HLIN2( 11)
      DIMENSION JEXY( 30)
C:DIM JEXY( MNY)
      DATA HLIN1/ 1HK, 2HKA, 3HKA1, 2HKB, 3HKB1, 2HLA, 3HLA1,
     1 3HLB1, 3HLB2, 2HMA, 3HMA1/
      DATA HLIN2/ 3HKA , 3HKA , 3HKA , 3HKB , 3HKB , 3HLA1,
     1 3HLA1, 3HLB1, 3HLB2, 3HMA1, 3HMA1/
C:----------
C:MOD  BEGIN                                OMIT FROM NRLEMP
      GO TO( 21, 42), KLY
      STOP 12
C:-------
 21   CONTINUE
       NSP= 0
C:MOD  END                                  OMIT FROM NRLEMP
 22   CALL IN( KR, 40, 2, KEND, HIN)
       IH= 1
      IF ( KEND.LT. 1) GO TO 17
C:SCR      READ( KS, 201) HXX, XXX
      DECODE( 16, 201, HIN( IH)) HXX, XXX
       IH= IH+ 4
 201  FORMAT( A8, E8.0)
      IF ( HXX.NE. HBLNK) WRITE( KW, 202)
 202  FORMAT( 2X, 30HERROR: LINES MUST BE NUMBERED.)
      IF ( HXX.NE. HBLNK) CALL ERROR( 0)
      IF ( HXX.NE. HBLNK) GO TO 17
       IY= XXX
      IF ( IY.GT. MNY) GO TO 11
       NZY( IY)= -999
       HLY( IY)= HLY( MNY)
C:XXX
       JEXY( IY)= NEXPT
      IF ( KEND.LT. 2) GO TO 22
C:SCR      READ( KS, HFA) HZY( IY)
      DECODE( 16, HFA, HIN( IH)) HZY( IY)
       IH= IH+ 4
      CALL ZABD( NZY( IY), HZY( IY), -1)
C:MOD  BEGIN                                OMIT FROM NRLEMP
       HLY( IY)= HLIN2( 1)
       KEND= KEND- 2
      IF ( KEND.LT. 1) GO TO 23
C:SCR      READ( KS, HFA) HLY( IY)
      DECODE( 16, HFA, HIN( IH)) HLY( IY)
       IH= IH+ 4
       KEND= KEND- 1
 23   CONTINUE
      CALL COND( KLY)
       JEXY( IY)= NEXPT
C:MOD  END                                  OMIT FROM NRLEMP
      GO TO 22
 11   WRITE( KW, 211) MNY
 211  FORMAT( 2X, 14H NO MORE THAN , I2,9H ALLOWED.)
      CALL ERROR( 0)
      GO TO 99
C:-------
 17   CONTINUE
       NY= 0
      DO 19 IY= 1, MNY
      IF ( NZY( IY).EQ. -999) GO TO 19
      IF ( IY.GT. NY) NY= IY
 19   CONTINUE
      IF ( NY.LE. 0) GO TO 99
      DO 18 IY= 1, NY
      IF ( NZY( IY).EQ. -999) GO TO 18
      IF ( NZY( IY).LE. 0) WRITE( KW, 205) HZY( IY)
      IF ( NEL.LE. 0) GO TO 36
      DO 32 IEL= 1, NEL
      IF ( NZY( IY).EQ. NZEL( IEL)) GO TO 18
 32   CONTINUE
 34   IF ( NEL.LT. MNEL) GO TO 36
      WRITE( KW, 204) MNEL
 204  FORMAT( 2X, 20HERROR: NOT MORE THAN, I3, 18H ELEMENTS ALLOWED.)
 205  FORMAT( 2X, A6, 31H  IS NOT AN ACCEPTABLE ELEMENT.)
      CALL ERROR( 0)
      GO TO 99
 36    NEL= NEL+ 1
       NZEL( NEL)= NZY( IY)
 18   CONTINUE
C:MOD  BEGIN                                OMIT FROM NRLEMP
      GO TO 60
C:-------
 42   CONTINUE
      CALL COND( KLY)
      DO 44 IY= 1, NY
 44    JEXY( IY)= 1
 60    KON21= 0
      IF ( NY.LE. 0) GO TO 99
      DO 61 IY= 1, NY
      IF ( NZY( IY).EQ. -999) GO TO 61
       IEXPT= JEXY( IY)
       JSPY( IY)= TEX( IEXPT, 6)
       HNT= HLY( IY)
      DO 24 IL= 1, 11
      IF ( HNT.EQ. HLIN1( IL)) GO TO 25
 24   CONTINUE
      WRITE( KW, 206) HNT
 206  FORMAT( 2X, A3, 38H IS NOT AN ACCEPTABLE LINE.  KA  USED.)
      CALL ERROR( 0)
       KON21= 1
       IL= 1
 25    HLY( IY)= HLIN2( IL)
      IF ( KON21.EQ. 0) GO TO 27
      CALL ERROR( 0)
      GO TO 99
 27    CONTINUE
       CSC1( IY)= 1./ SIN( 0.017453293* TEX( IEXPT, 1))
       CSC2( IY)= 1./ SIN( 0.017453293* TEX( IEXPT, 2))
 61   CONTINUE
C:MOD  END                                  OMIT FROM NRLEMP
 99   CONTINUE
C:BUG      WRITE( 6, *) ( JEXY( IY), IY= 1, NY)
C:BUG      WRITE( 6, *) ( JSPY( IY), IY= 1, NY)
      RETURN
C:-------
      END
C:****END     LINE
C:****BEGIN   JZYS
      SUBROUTINE JZYS( NZY, JZY, NY, NZEL, NEL)
      DIMENSION NZY( NY), JZY( NY), NZEL( NEL)
      DO 3 IY= 1, NY
       NZYT= NZY( IY)
      DO 1 IZ= 1, NEL
      IF ( NZYT.EQ. NZEL( IZ)) GO TO 2
 1    CONTINUE
C:BUG      WRITE( 6, 601) IY
 601  FORMAT( 2X, 42H WARN: ELEMENT NOT PRESENT FOR MEASUREMENT, I3)
       JZY( IY)= 0
      GO TO 3
 2     JZY( IY)= IZ
 3    CONTINUE
      RETURN
      END
C:****END     JZYS
C:****BEGIN   QUAN
      SUBROUTINE QUAN( JZY, NQ, NY, NX, NEL)
       Character*16 HIN
      DOUBLE PRECISION HXU, HABB, HUND
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
      COMMON/HFS/ HFE( 3), HFA( 2)
      COMMON/LMC/ PURE( 30), ROMZ( 30), YY( 30)
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
      DIMENSION JZY( NY)
      DIMENSION CC( 20), YC( 30), XG( 20)
C:DIM  CC( MNEL), YC( MNY), XG( MNX)
      DATA HUND/ 6H------/
C:----------
      IF ( NQ.EQ. 12) GO TO 11
      IF ( KPREP.NE. 0) KADJB= 1
      IF ( KOP.EQ. 1) GO TO 4301
C:MOD  BEGIN                                OMIT FROM NRLEMP
      IF ( KPREP.NE. 0) KADJY= 2
      IF ( KADJY.NE. 0) CALL YNORM( NX, NY, NEL, JZY)
      IF ( KOP.NE. 2) GO TO 4301
      CALL XSAMP( JSR, XU, XG, NX, 0)
      IF ( KIND.NE. 3) CALL NORM( XU, NX, 1., XMULT)
      CALL XTOC( CC, NEL, XU, NX)
      CALL SIM( XU, NX, YC, NY, CC, NEL)
C:MOD  END                                  OMIT FROM NRLEMP
      GO TO 40
C:-------
 11   CALL XTOC( CC, NEL, XU, NX)
      WRITE( KW, 212)
 212  FORMAT( 2X)
      DO 391 IZ= 1, NEL
       COUT= CC( IZ)
      IF ( KPCT.NE. 0) COUT= COUT* 100.
      IF ( CC( IZ).LE. 0.) GO TO 391
      CALL ZABD( NZEL( IZ), HABB, 1)
      IF ( HABB.EQ. HUND) GO TO 391
      IF ( KPCT.NE. 0) WRITE( KW, 207) HABB, COUT
      IF ( KPCT.EQ. 0) WRITE( KW, 242) HABB, COUT
 391  CONTINUE
      WRITE( KW, 212)
      GO TO 999
C:-------
 40   CONTINUE
      IF ( KOUT.EQ. 2) GO TO 38
      IF ( KIND.EQ. 3) WRITE( KW, 216)
      IF ( KIND.NE. 3) WRITE( KW, 271)
 271  FORMAT(/ 2X, 4X, 4HLINE, 6X, 3HRXI/)
 38   IF ( KOUT.EQ. 2) WRITE( KW, 213)
 213  FORMAT(/ 2X, 4X, 4HLINE,
     1 6X,3HRXI,6X,41HRXI/C     XI/XI0    PH/SR/SR   PH/SR/SR/G/)
 216  FORMAT(/ 2X, 4X, 4HLINE, 6X, 6HXI/XI0/)
 215  FORMAT( 2X, I3, 1X, A2, 1X, A3, F10.6)
      DO 42 IY= 1, NY
       IZ= JZY( IY)
      CALL ZABD( NZEL( IZ), HABB, 1)
      IF ( HABB.EQ. HUND) GO TO 42
      IF ( KIND.NE. 3) GO TO 47
       ROMIR= YC( IY)/ ROMZ( IY)
       ABIM= YC( IY)
       ABI= CC( IZ)* ABIM
       YY( IY)= ABI/ PURE( IY)
      IF ( KOUT.EQ. 1) WRITE( KW, 209) IY, HABB, HLY( IY), ROMIR
      IF ( KOUT.EQ. 2) WRITE( KW, 229) IY, HABB, HLY( IY),
     1 ROMIR, ABI, ABIM
      GO TO 42
C:    -------
 47    RXI= CC( IZ)* YC( IY)
       YY( IY)= RXI
       ROMIR= 0.
       ABIM= 0.
       ABI= RXI* PURE( IY)
      IF ( KIND.EQ. 1) GO TO 41
       CONST= ROMZ( IY)* ABS( THICK)
      IF ( CONST.EQ. 0.) GO TO 41
       ROMIR= YC( IY)* PURE( IY)/ CONST
       ABIM= ROMIR* ROMZ( IY)
 41   CONTINUE
      IF ( KOUT.EQ. 1) WRITE( KW, 209) IY, HABB, HLY( IY), RXI
      IF ( KOUT.EQ. 2) WRITE( KW, 209) IY, HABB, HLY( IY),
     1 RXI, YC( IY), ROMIR, ABI, ABIM
 42   CONTINUE
      WRITE( KW, 212)
      GO TO 999
C:-------
 4301 CONTINUE
C:MOD  BEGIN            OMIT FROM NRLSIM
      IF ( NQ.GT. 13) GO TO 999
      IF ( NQ.LE. 3) GO TO 999
      CALL  UNK( NZY, JZY, HLY, NQ, NY, NX, NEL)
C:MOD  END              OMIT FROM NRLSIM
 999  CONTINUE
      RETURN
C:-------
 209  FORMAT( 2X, I3, 1X, A2, 1X, A3, 3F10.6, 2E12.4)
 206  FORMAT( 2X, 6A11)
 207  FORMAT( 2X, 1X, A6, 2X, F9.4)
 242  FORMAT( 2X, 1X, A6, 2X, E11.4)
 229  FORMAT( 2X, I3, 1X, A2, 1X, A3,  20X, F10.6, 2E12.4)
      END
C:****END     QUAN
C:****BEGIN   UNK       OMIT FROM NRLSIM
      SUBROUTINE UNK( NZY, JZY, HLY, NQ, NY, NX, NEL)
       Character*16 HIN
      DOUBLE PRECISION HXU, HABB, HTEST, HSAMP, HXS, HUND
      DOUBLE PRECISION HFMF7, HFMF9, HFMF1, HFMF2, HFMF8
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/HFS/ HFE( 3), HFA( 2)
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/GRAIN/ TBAR( 20), DEN( 20), VVOID, TVOID
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMX/ HXS( 51, 20), X1( 51, 20, 2)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
C:MOD  BEGIN                                OMIT FROM NRLEMP
      COMMON/YNORC/ YNOR( 51, 30)
C:MOD  END                                  OMIT FROM NRLEMP
      DIMENSION NZY( NY), JZY( NY), HLY( NY)
      DIMENSION RERR( 30), XG( 20)
C:DIM  RERR( MNY), XG( MNX)
      DIMENSION YC( 30), YU( 30)
C:DIM  YC( MNY), YU( MNY)
      DIMENSION DX( 20), BX( 20), DBX( 20)
C:DIM  DX( MNX), BX( MNX), DBX( MNX)
      DIMENSION HFMF7( 5), HFMF9( 5), HFMF1( 16), HFMF2( 19)
      DIMENSION HFMF8( 5)
C:DIM  HFMF7( 5), HFMF8( 5), HFMF9( 5), HFMF1( 16), HFMF2( 19)
      DATA HUND/ 6H------/
      DATA HPLUS/ 1H+/, HMINUS/ 1H-/
      DATA LIMIT/ 12/
      DATA HFMF7/ 6H3.0,6X, 6H4.1,5X, 6H5.2,4X, 6H6.3,3X,
     1 6H7.4,2X/
      DATA HFMF9/ 6H5.0,5X, 6H6.1,4X, 6H7.2,3X, 6H8.3,2X,
     1 6H9.4,1X/
      DATA HFMF1/ 6H(  3X,, 6HA10,2P, 6H F9.4,, 6H4H +/-,
     1 6H , 2PF, 6H      , 6H     ,, 6HA1,2PF, 6H      ,
     1 6H     ,, 6H1X,2PF, 6H      , 6H,3H   , 6H,  2PF,
     1 6H      , 6H     )/
      DATA HFMF2/ 6H(  3X,, 6H4H(TOT, 6H3HAL),, 6H3X,2PF,
     1 6H9.4,1X, 6H      , 6H      , 6H      , 6H,   A1, 6H,  2PF,
     1 6H      , 6H,  1X,, 6H   2PF,
     1 6H      , 6H,3H   , 6H,  2PF, 6H      , 6H     ), 6H      /
      DATA HFMF8/ 6H 3H(FI, 6H4HXED), 6H,   5X, 6H3H+/-,, 6H   2PF/
      DATA KOPZ/ 0/, JSRZ/ 0/
C:----------
      IF ( KOP.NE. KOPZ) NIT= 0
      IF ( JSR.NE. JSRZ) NIT= 0
      IF ( NQ.NE. 13) NIT= 0
      IF ( NQ.LE. 10) STOP 42
      IF ( NQ.GT. 13) STOP 42
      IF ( NQ.LE. 10) GO TO 98
      IF ( NQ.EQ. 11) GO TO 55
      IF ( NQ.EQ. 12) GO TO 98
      IF ( NIT.GT. 0) GO TO 54
      GO TO 55
C:-------
 47   WRITE( KW, 215)
 215  FORMAT(/ 2X, 36HNOT ENOUGH INTENSITIES FOR ANALYSIS.)
C:ALT      CALL ERROR( 0)
      GO TO 43
C:-------
 45   IF ( NQ.NE. 11) GO TO 43
      GO TO 98
C:-------
 43   CONTINUE
       KOPZ= KOP
       JSRZ= JSR
      GO TO 98
C:-------
 55   CONTINUE
      IF ( JSR.LE. 0) GO TO 43
       NBIG= 0
       NNEG= 0
      DO 53 IY= 1, NY
      YU( IY)= -1.0
C:X??     IF ( Y1( JSR, IY).LT. 0.) NNEG= NNEG+ 1
      IF ( Y1( JSR, IY).LT. 0.) GO TO 53
      IF ( NZY( IY).EQ. 0) GO TO 53
       RERR( IY)= ABS( YE( JSR, IY))
       YU( IY)= Y1( JSR, IY)
C:MOD  BEGIN                                OMIT FROM NRLEMP
      IF ( KOP.NE. 3) GO TO 53
      IF ( YE( JSR, IY).LT. 0.) GO TO 53
       ISN= YN( IY)
      IF ( ISN.GT. 0) YU( IY)= Y1( JSR, IY)/ YNOR( ISN, IY)
      IF ( YU( IY).GT. 10.) NBIG= NBIG+ 1
C:MOD  END                                  OMIT FROM NRLEMP
 53   CONTINUE
      IF ( KOP.LE. 2) GO TO 170
C:X??     IF ( NNEG.GT. 0) GO TO 178
      IF ( KIND.EQ. 3) GO TO 170
      IF ( NBIG.LE. 0) GO TO 170
      GO TO 179
C:    -------
170   CALL XSAMP( JSR, XU, XG, NX, 0)
      IF ( KOP.EQ. 2) GO TO 45
      IF ( NQ.EQ. 11) NIT= 0
      IF ( NIT.NE. 0) GO TO 54
      IF ( KOP.EQ. 3) GO TO 54
      IF ( KOP.EQ. 4) GO TO 54
C:DOC I.E., KOP= 1 (EMPIRICAL)
      IF ( KOP.NE. 1) GO TO 180
      IF ( NS1.LE. 2) GO TO 180
       NSTD= NS1
C:ALT       KADJB= 1
C:MOD  BEGIN            OMIT FROM NRLSIM
      CALL  GAMBS( -1, NX, NY, XU, YU, JZY)
C:MOD  END              OMIT FROM NRLSIM
 54   IF ( NQ.EQ. 11) KONIT= 1
      IF ( NQ.EQ. 13) KONIT= 2
C:
C:MOD  BEGIN            OMIT FROM NRLSIM
      CALL  ITER( NFREE, KONIT, NIT, NY, NX, JZY, YC,
     1 YU, XU, XG, DX, BX, DBX, NEL, RERR, LIMIT)
C:MOD  END              OMIT FROM NRLSIM
C:
      IF ( KONIT.LT. 0) GO TO 47
      IF ( KONIT.GT. 0) GO TO 801
      WRITE( KW, 211)
      GO TO 180
C:-------
 178  WRITE( KW, 302)
 302  FORMAT( 2X, 44H ERROR:  SOME INTENSITY< 0.  CANNOT ANALYZE.)
      GO TO 180
C:-------
 179  WRITE( KW, 301)
 301  FORMAT( 2X, 44H ERROR?  SOME RXI> 10.  CONSIDER "NORMALIZE")
 180  CONTINUE
C:ALT      CALL ERROR( 0)
      GO TO 43
C:-------
 801  CONTINUE
 221  FORMAT(/ 2X, 5X, 4HLINE, 6X, 9H XI MEAS., 1X, 9H XI CALC.,
     1 2X, 8HPCT DIFF, 2X, 7HASSUMED)
 222  FORMAT(/ 2X, 1X, 10H    LINE  , 4X, 9H XI MEAS.)
C:ALT      IF ( KOUT.EQ. 1) WRITE( KW, 222)
      IF ( KOUT.EQ. 2) WRITE( KW, 221)
       CHI= 0.
       CHI2= 0.
       KRERR= 0
       KDOUT= -1
      DO 81 IY= 1, NY
      IF ( RERR( IY).NE. 0.01) KRERR= 1
      IF ( YU( IY).LT. 0.) GO TO 81
       YCIY= YC( IY)
       YUIY= YU( IY)
       DENOM= .005*( YUIY+ YCIY)
       PCD= 0.
       DIFY= YUIY- YCIY
       SIGY= RERR( IY)* YUIY
      IF ( SIGY.EQ. 0.) SIGY= RERR( IY)
       CHI2= CHI2+( DIFY/ SIGY)** 2
      IF ( ABS( DENOM).GT. 1.E-30) PCD= DIFY/ DENOM
       STDER= 999999.
      IF ( NFREE.GT. 0)
     1 STDER= PCD* SQRT( FLOAT( NY)/ FLOAT( NFREE))
C:ALT      IF ( ABS( PCD).LE. 0.05) GO TO 81
      CALL ZABD( NZY( IY), HABB, 1)
      IF ( HABB.EQ. HUND) GO TO 81
C:ALT      IF ( KOUT.EQ. 1) WRITE( KW, 209) IY, HABB, HLY( IY), YUIY
      IF ( KOUT.EQ. 1) GO TO 81
      IF ( KOUT.EQ. 2) WRITE( KW, 209) IY, HABB, HLY( IY), YUIY,
     1 YCIY, PCD, RERR( IY)
 81   CONTINUE
 209  FORMAT( 2X, I3, 1X, A2, 1X, A5, 2X, E10.4, 1X,
     1 E10.4, F7.1, 4X, 3H+/-, 2PF5.1)
       NQ= 13
 80   CONTINUE
C:BUG      WRITE( 6, *) NIT
      IF ( KONIT.EQ. 5) WRITE( KW, 255) NIT
      IF ( KOUT.EQ. 1) WRITE( KW, 263)
 263  FORMAT(/ 2X, 19H COMPONENT   AMOUNT/)
      IF ( KOUT.NE. 2) GO TO 39
      IF ( NFREE.LE. 0) WRITE( KW, 229)
 229  FORMAT(/ 2X, 14H CHI UNDEFINED,
     1       / 2X, 27H FOR  0 DEGREES OF FREEDOM.)
      IF ( NFREE.LE. 0) GO TO 86
       CHI2= CHI2/ FLOAT( NFREE)
       CHI= SQRT( CHI2)
      WRITE( KW, 230) CHI
      IF ( NFREE.EQ. 1) WRITE( KW, 236) NFREE
      IF ( NFREE.GT. 1) WRITE( KW, 232) NFREE
 230  FORMAT(/ 2X, 5H CHI=, F7.2,
     1 49H (EST. RMS RATIO OF OBSERVED TO ASSUMED PCT DIFF))
 232  FORMAT( 2X, 4H FOR, I3, 20H DEGREES OF FREEDOM.)
 236  FORMAT( 2X, 4H FOR, I3, 19H DEGREE OF FREEDOM.)
 86   CONTINUE
      IF ( KONIT.LE. 2) WRITE( KW, 252) NIT
      IF ( KONIT.EQ. 3) WRITE( KW, 253) NIT
      IF ( KONIT.EQ. 4) WRITE( KW, 254) NIT
 231  FORMAT(/ 2X, 37H IMPREC. IS IMPRECISION (STD DEV) DUE,
     1 26H TO ASSUMED RANDOM ERRORS.,
     1 / 2X, 29H BIAS IS A LINEAR ADJUSTMENT,,
     1 31H IGNORING THE OTHER COMPONENTS./)
 38   IF ( KPCT.NE. 0) WRITE( KW, 233)
      IF ( KPCT.EQ. 0) WRITE( KW, 237)
 233  FORMAT(/ 2X, 20H COMPONENT   AMOUNT ,10H   IMPREC.,
     1 9H     BIAS, 5X, 8HADJUSTED/)
 237  FORMAT(/ 2X, 20H COMPONENT     MASS ,10H   IMPREC.,
     1 9H     BIAS, 5X, 8HADJUSTED/)
 39    SUM1= 0.
       SUM2= 0.
       SUM3= 0.
C:ALT       SUM4= 0.
       SUM5= 0.
      DO 803 IX= 1, NX
      IF ( HXU( IX).EQ. HUND) GO TO 803
       SUM1= SUM1+ XU( IX)
      IF ( XG( IX).LT. 0.) GO TO 51
       SUM3= SUM3+ XU( IX)
      IF ( KOUT.EQ. 2) GO TO 78
      IF ( KPCT.NE. 0) WRITE( KW, 235) HXU( IX), XU( IX)
      IF ( KPCT.EQ. 0) WRITE( KW, 238) HXU( IX), XU( IX)
      GO TO 803
C:    -------
 78   IF ( KPCT.NE. 0) WRITE( KW, 235) HXU( IX), XU( IX), XU( IX)
      IF ( KPCT.EQ. 0) WRITE( KW, 238) HXU( IX), XU( IX), XU( IX)
 238  FORMAT( 2X, 1X, A10, 1X, E10.4, 12H (FIXED)    , 10X, E12.4)
 243  FORMAT( 2X, 1X, A10, 2PF7.2)
 244  FORMAT( 2X, 1X, A10, 2PF8.3)
 245  FORMAT( 2X, 1X, A10, 2PF9.4)
      GO TO 803
C:    -------
 51    W2= XU( IX)+ BX( IX)
       SUM2= SUM2+ BX( IX)
       SUM3= SUM3+ W2
C:ALT       SUM4= SUM4+ DBX( IX)** 2
       SUM5= SUM5+ DX( IX)** 2
       BIAS= ABS( BX( IX))
      IF ( KOUT.EQ. 2)  GO TO 77
      IF ( KPCT.EQ. 0) WRITE( KW, 265) HXU( IX), XU( IX)
      GO TO 76
 77   IF ( KPCT.EQ. 0) WRITE( KW, 239)
     1 HXU( IX), XU( IX), DX( IX), BX( IX), W2
 239  FORMAT( 2X, 1X, A10, 1X, E10.4, 4H +/-, E8.2,
     1 1X, E8.2, 1X, E10.4,          E8.2)
 265  FORMAT( 2X, 1X, A10, 1X, E10.4)
 76   IF ( KPCT.EQ. 0) GO TO 803
       HSIGN= HPLUS
      IF ( BX( IX).LT. 0.) HSIGN= HMINUS
       II= 1+ MIN0( 4, MAX0( 0, IFIX( - ALOG10( DX( IX)+ 1.E-30))))
       HFMF1( 6)= HFMF7( II)
       II= 1+ MIN0( 4, MAX0( 0, IFIX( - ALOG10( BIAS+ 1.E-30))))
       HFMF1( 9)= HFMF7( II)
       II= MIN0( 5, MAX0( 1, IFIX( - ALOG10( DX( IX)+ 1.E-30))))
       HFMF1( 12)= HFMF9( II)
C:XXX     IF ( KOUT.EQ. 1) WRITE( KW, 243) HXU( IX), XU( IX)
      IF ( KOUT.EQ. 2) WRITE( KW, HFMF1) HXU( IX), XU( IX),
     1 DX( IX), HSIGN, BIAS, W2
      IF ( KOUT.EQ. 2) GO TO 803
      IF ( KOUT.NE. 1) GO TO 803
      IF ( XU( IX).GE. 0.01) WRITE( KW, 243) HXU( IX), XU( IX)
      IF ( XU( IX).GE. 0.01) GO TO 803
      IF ( XU( IX).LT. 0.001) WRITE( KW, 245) HXU( IX), XU( IX)
      IF ( XU( IX).LT. 0.001) GO TO 803
      WRITE( KW, 244) HXU( IX), XU( IX)
 803  CONTINUE
       SUM5= SQRT( SUM5)
C:ALT       SUM4= SQRT( SUM4)
      IF ( KPCT.EQ. 0) GO TO 804
      IF ( KOUT.NE. 2) GO TO 75
       HSIGN= HPLUS
      IF ( SUM2.LT. 0.) HSIGN= HMINUS
       SUM2= ABS( SUM2)
       II= 1+ MIN0( 4, MAX0( 0, IFIX( - ALOG10( SUM2+ 1.E-30))))
       HFMF2( 11)= HFMF7( II)
       II= MIN0( 5, MAX0( 1, IFIX( - ALOG10( SUM5+ 1.E-30))))
       HFMF2( 14)= HFMF9( II)
      IF ( XUS.GT. 0.) HFMF2( 6)= HFMF8( 1)
      IF ( XUS.GT. 0.) HFMF2( 7)= HFMF8( 2)
      IF ( XUS.GT. 0.) HFMF2( 8)= HFMF8( 3)
      IF ( XUS.LE. 0.) HFMF2( 6)= HFMF8( 4)
      IF ( XUS.LE. 0.) HFMF2( 7)= HFMF8( 5)
       II= 1+ MIN0( 4, MAX0( 0, IFIX( - ALOG10( SUM5+ 1.E-30))))
      IF ( XUS.LE. 0.) HFMF2( 8)= HFMF7( II)
      IF ( KOUT.NE. 2) GO TO 75
      IF ( XUS.GT. 0.) WRITE( KW, HFMF2) SUM1, HSIGN, SUM2, SUM3
      IF ( XUS.LE. 0.)
     1 WRITE( KW, HFMF2) SUM1, SUM5, HSIGN, SUM2, SUM3
C:ALT234   FORMAT( 2X, 1X, A10, 2PF9.4, 1X, 3H+/-, 2PF7.4, 2X, A1,
C:ALT     1  2PF7.4, 3X, 2PF9.4, 2X,        2PF7.4)
 235  FORMAT( 2X, 1X, A10, 2PF9.4, 8H (FIXED), 16X, 2PF9.4)
      IF ( KOUT.NE. 1) WRITE( KW, 231)
      IF ( KOUT.EQ. 1) WRITE( KW, 212)
      GO TO 43
C:-------
 804  IF ( XUS.GT. 0.)
     1 WRITE( KW, 247) SUM1, SUM2, SUM3
      IF ( XUS.LE. 0.)
     1 WRITE( KW, 246) SUM1, SUM5, SUM2, SUM3
      GO TO 43
 246  FORMAT( 2X, 9H (TOTAL) , 3X, E10.4, 4H +/-, E8.2,
     1 1X, E8.2, 1X, E10.4,          E8.2)
 247  FORMAT( 2X, 9H (TOTAL) , 3X, E10.4, 12H (FIXED)    ,
     1 1X, E8.2, 1X, E10.4,          E8.2)
 266  FORMAT( 2X, 9H (TOTAL) , 3X, E10.4)
 267  FORMAT( 2X, 9H (TOTAL) , 3X, E10.4, 12H (FIXED)    )
C:-------
 75   IF ( XUS.LE. 0.) WRITE( KW, 248) SUM1
      IF ( XUS.GT. 0.) WRITE( KW, 249) SUM1
 248  FORMAT( 2X, 9H (TOTAL) , 2X, 2PF7.2)
 249  FORMAT( 2X, 9H (TOTAL) , 2X, 2PF9.4, 8H (FIXED))
      WRITE( KW, 212)
      GO TO 43
C:-------
 206  FORMAT( 2X, 6A11)
 207  FORMAT( 2X, 1X, A2, 8X, F9.4)
 252  FORMAT(/ 2X, 9H ESTIMATE, I3)
 253  FORMAT(/ 2X, 9H ESTIMATE, I3, 24H: COMPOSITION CONVERGED.)
 254  FORMAT(/ 2X, 9H ESTIMATE, I3, 24H: INTENSITIES CONVERGED.)
 255  FORMAT(/ 2X, 9H ESTIMATE, I3, 18H: ITERATION LIMIT.)
 211  FORMAT( 2X, 18H NO SOLUTION FOUND)
 212  FORMAT( 2X)
C:-------
 98   RETURN
C:-------
      END
C:****END     UNK       OMIT FROM NRLSIM
C:****BEGIN   XTOC
      SUBROUTINE XTOC( CC, NEL, XU, NX)
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      DIMENSION CC( NEL), XU( NX)
      DO 2 IZ= 1, NEL
       SUM= 0.
      DO 1 IX= 1, NX
 1     SUM= SUM+ XU( IX)* PELC( IZ, IX)
 2     CC( IZ)= SUM
      RETURN
C:-------
      END
C:****END     XTOC
C:****BEGIN   SPIN                          OMIT FROM NRLEMP
      SUBROUTINE SPIN( H1, F1, H2, F2, F3, F4, II, KP, NW, W1, SP1, MNW)
       Character*16 HIN
      DOUBLE PRECISION H1, H2, HNT1, HNT2, HEND, HKEV, HANG, HBL6
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/HFS/ HFE( 3), HFA( 2)
      DIMENSION W1( MNW), SP1( MNW), W2( 100), SP2( 100)
      DATA HBL6/ 6H      /
      DATA HEND/ 6HEND   /, HKEV/ 6HKEV   /, HANG/ 6HA     /
      IF ( H1.EQ. HBL6) GO TO 2
       KP= -1
C:MOD  BEGIN     ONLY IF DATA FILE XRDATS IS USED
       KRSP= KUF( 1)
      CALL FILIO( KRSP, 1, 1, 1, 1)
 1    READ( KRSP, 100) HNT1
      IF ( HNT1.EQ. HEND) GO TO 2
      IF ( HNT1.NE. H1) GO TO 1
 100  FORMAT(6X, A8)
      CALL IN( -1, -2, 2, KEND, HIN)
      CALL IN( KRSP, 1, 0, KEND, HIN)
       IH= 1
C:SCR      READ( KS, HFE) XXX
      DECODE( 16, HFE, HIN( IH)) XXX
       IH= IH+ 4
       NW= XXX
 5     KP= -2
      IF (( II+ NW).GT. MNW) GO TO 98
       KP= -1
       IW2= II
       NR= 0
 55   CALL IN( KRSP, 2* NW- NR, 2, KEND, HIN)
       IH= 1
C:XXX
       IW1= IW2+ 1
       IW2= IW1- 1+ KEND/ 2
C:SCR      READ( KS, HFE) ( W1( IW), SP1( IW), IW= IW1, IW2)
       NR= NR+ KEND
      DO 31 IW= IW1, IW2
      DECODE( 16, HFE, HIN( IH)) W1( IW)
       IH= IH+ 4
      DECODE( 16, HFE, HIN( IH)) SP1( IW)
       IH= IH+ 4
 31   CONTINUE
      IF ( NR.LT. 2* NW) GO TO 55
 3     KP= 0
      CALL IN( -1, -2, 2, KEND, HIN)
  98  CALL FILIO( KRSP, 1, 1, 1, 2)
C:MOD  END       ONLY IF DATA FILE XRDATS IS USED
  99  RETURN
C:-------
 2     KP= 1
      IF ( H2.EQ. HKEV) GO TO 6
      IF ( H2.EQ. HANG) GO TO 6
      CALL ZABD( NZI, H1, -1)
      IF ( NZI.LE. 0) GO TO 99
      IF ( F2.NE. 0.) GO TO 10
       JLINE= JLDF( H2)
      IF ( JLINE.LE. 0) GO TO 99
       NW= 1
       KP= -2
      IF (( II+ NW).GT. MNW) GO TO 99
       IW= II+ 1
       W1( IW)= WLF( NZI, JLINE)
       SP1( IW)= 1.
       KP= 0
      GO TO 99
C:-------
 6    CONTINUE
      IF ( F1.LE. 0.) GO TO 99
       NW= 1
       KP= -2
      IF (( II+ NW).GT. MNW) GO TO 99
       IW= II+ 1
      IF ( H2.EQ. HKEV) W1( IW)= 12.398/ F1
      IF ( H2.EQ. HANG) W1( IW)= F1
       SP1( IW)= 1.
       KP= 0
      GO TO 99
C:-------
10    CONTINUE
C:MOD  BEGIN   ONLY IF X-RAY TUBE SPECTRUM IS CALCULATED
      RAD2= F3
      RAD1= 3.1415925/ 2.- RAD2
      IF ( RAD2.GT. 3.14159/ 4.) RAD1= RAD2
      BET= F4
      CALL TUBE( F2, RAD1, NZI, RAD2, BET, NW, W2, SP2, 0, KW)
      KP= -2
      IF (( II+ NW).GT. MNW) GO TO 99
      KP= -1
      DO 12 IW1= 1, NW
      W1( II+ IW1)= W2( IW1)
   12 SP1( II+ IW1)= SP2( IW1)
      KP= 0
C:MOD  END     ONLY IF X-RAY TUBE SPECTRUM IS CALCULATED
      GO TO 99
C:-------
      END
C:****END     SPIN                          OMIT FROM NRLEMP
C:****BEGIN   PREP                          OMIT FROM NRLEMP
      SUBROUTINE PREP( NEL, NY)
       Character*16 HIN
      DOUBLE PRECISION HABB
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      COMMON/SPEC1/ NW1, W1( 300), SP1( 300), JSP1( 31), NSP
      COMMON/SPEC2/ NW2, W2( 80), SP2( 300), JSP2( 30), RMESH
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
      COMMON/PARAM/ NOL, JZL( 50), L6( 50), WLL( 50), JWL( 50),
     1 UC( 20, 50), BC( 20, 80)
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      DIMENSION XLIN( 100), WEDG( 100), LNM( 30), WEL( 50)
C:DIM  XLIN( MNIN), WEDG( MNIN), LNM( MNY), WEL( MNOL)
      DIMENSION HLINE( 6)
C:DIM  HLINE( 6)
      DATA HLINE/ 3HKA , 3HKB , 3HLA1, 3HLB1, 3HLB2, 3HMA1/
C:----------
C:
C:DOC FIND WEMX: MAX EDGE-LAM FOR MEAS LINES; SET UP LNM( IY)
       WEMX= 0.
      DO 1 IY= 1, NY
       LNM( IY)= 1
       NZMI= NZY( IY)
      IF ( NZMI.EQ. 0) GO TO 1
      DO 15 IND= 1, 6
      IF ( HLY( IY).EQ. HLINE( IND)) GO TO 21
   15 CONTINUE
       IND= 1
      CALL ZABD( NZMI, HABB, 1)
      WRITE( KW, 207) HABB, HLY( IY), HABB
 207  FORMAT( 2X, 6HWARN: , A2, 1X, A3,10H INVALID; , A2,9H KA USED.)
 21    LNM( IY)= IND
       WL= WLF( NZMI, IND)
       WE= WEF( NZMI, IND)
      IF ( WL* WE.GT. 0.) GO TO 18
      CALL ZABD( NZMI, HABB, 1)
      WRITE( KW, 201) HABB, HLINE( IND)
 201  FORMAT( 2X, 6HWARN: , A2, 1X, A3, 21H (OR EDGE) LAMBDA= 0.)
 18   IF ( WE.GT. WEMX) WEMX= WE
 1    CONTINUE
C:
C:DOC FIND MIN LAMBDA INCIDENT
       W1MIN= 9999.
      DO 16 IW= 1, NW1
      IF ( W1( IW).LT. W1MIN) W1MIN= W1( IW)
 16   CONTINUE
C:
C:DOC FIND ALL SIGNIF LINES EXCITED, AND THEIR EDGES, ETC.
       NL= 0
      DO 6 IZ= 1, NEL
       NZI= NZEL( IZ)
      DO 5 L= 1, 6
       LLL= L
       WL= WLF( NZI, LLL)
      IF ( WL.GE. 999.) GO TO 5
      IF ( WL.GT. 0.) GO TO 19
C:BUG      CALL ZABD( NZI, HABB, 1)
C:BUG      WRITE( KW, 202) HABB, HLINE( L)
 202  FORMAT( 2X, 6HWARN: , A2, 1X, A3, 18H WILL NOT BE USED.)
      GO TO 5
C:    -------
 19   CONTINUE
       WE= WEF( NZI, LLL)
      IF ( WE.GT. 0.) GO TO 20
      CALL ZABD( NZI, HABB, 1)
C:BUG      WRITE( KW, 202) HABB, HLINE( L)
      GO TO 5
C:    -------
 20   IF ( WE.LT. W1MIN) GO TO 5
      IF ( WE.GT. WEMX) GO TO 6
       FLW1= FLF( NZI, LLL, W1MIN, KFL)
      IF ( KFL.EQ. 0) GO TO 11
      CALL ZABD( NZI, HABB, 1)
      WRITE( KW, 205) HABB, HLINE( LLL)
 205  FORMAT( 2X, 11HWARN: SOME , A2, 1X, A3,
     1 24H YIELDS INCOMPUTABLE....)
      GO TO 5
 11    NL= NL+ 1
      IF ( NL.LE. MNOL) GO TO 4
      WRITE( KW, 203) MNOL
 203  FORMAT( 2X, 49H ERROR: INDIRECT FLUORESCENCE REQUIRES MORE THAN,
     1 I3, 07H LINES.)
      CALL ERROR( 0)
      NL= NL- 1
      GO TO 6
C:XXX
C:    -------
 4     JZL( NL)= IZ
       L6( NL)= L
       WLL( NL)= WL
       WEL( NL)= WE
       WEDG( NL)= WE
 5    CONTINUE
 6    CONTINUE
C:
C:DOC FIND LINES AND EDGES IN INCIDENT SPECTRA
       NEDG= NL
      CALL  POINT( WEMX, NLIN, NEDG, XLIN, WEDG, MNIN)
C:
C:DOC SUBDIVIDE AND WEIGHT INCIDENT SPECTRA
      CALL  SPECW( NLIN, XLIN, NEDG, WEDG, MNIN)
C:BUG      WRITE( KW, 7701) NW2
C:BUG7701  FORMAT( 2X, 35HW2( N), SP2( N), ETC. FOR N= 1,...,, I3)
C:BUG      DO 888 N= 1, NW2
C:BUG      WRITE( 6, 7705) W2( N)
C:BUG      DO 887 ISP= 1, NSP
C:BUG887   WRITE( 6, 7706) SP2( N+ ISP* NW2- NW2)
C:BUG888   CONTINUE
C:BUG7705  FORMAT(/ 2X, F7.4$)
C:BUG7706  FORMAT( 2X, E12.5$)
C:BUG      WRITE( 6, *) NNN
C:
C:DOC CALC ALL ABS COEFFS
      DO 9 IZ= 1, NEL
        NZI= NZEL( IZ)
       KAB= 0
      DO 7 IL= 1, NL
       WAVE= WLL( IL)
       UC( IZ, IL)= EMACF( NZI, WAVE, 1, KMAC)
      IF ( KMAC.NE. 0) KAB= 1
 7    CONTINUE
      IF ( NW2.LT. 1) GO TO 10
      DO 8 N= 1, NW2
       WAVE= W2( N)
       BC( IZ, N)= EMACF( NZI, WAVE, 1, KMAC)
      IF ( KMAC.NE. 0) KAB= 1
 8    CONTINUE
   10 CONTINUE
      IF ( KAB.EQ. 0) GO TO 9
      CALL ZABD( NZI, HABB, 1)
      WRITE( KW, 204) HABB
 9    CONTINUE
 204  FORMAT( 2X, 12H WARN: SOME , A2, 16H ABS. COEFFS= 0.)
       NOL= NL
C:
C:DOC CHECK THAT MEAS LINES FLUOR; SET UP JLM( IY)
      DO 14 IY= 1, NY
       IL= 0
       NT1= NZY( IY)
      IF ( NT1.LE. 0) GO TO 14
       NT2= LNM( IY)
      DO 13 IL= 1, NOL
       IZLI= JZL( IL)
      IF ( NT1.NE. NZEL( IZLI)) GO TO 13
      IF ( NT2.EQ. L6( IL)) GO TO 14
 13   CONTINUE
       IL= 0
      CALL ZABD( NT1, HABB, 1)
      WRITE( KW, 206) HABB, HLINE( NT2)
 206  FORMAT( 2X, 6HWARN: , A2, 1X, A3, 19H IS NOT FLUORESCED.)
 14    JLM( IY)= IL
C:
C:DOC SET UP JWL( IL): INTEGRATION RANGE FOR EACH SAMPLE LINE
       N1= NLIN+ 1
      DO 22 IL= 1, NOL
       IW= N1
      IF ( N1.GT. NW2) GO TO 3
       WE= WEL( IL)
      DO 2 IW= N1, NW2
      IF ( W2( IW).GE. WE) GO TO 3
 2    CONTINUE
       IW= NW2+ 1
 3     JWL( IL)= IW- 1
C:BUG      WRITE( KW, 7702) IL, JWL( IL)
C:BUG7702  FORMAT( 2X, 4HJWL(, I3,2H)=, I3)
 22   CONTINUE
       KPREP= 0
      RETURN
C:-------
      END
C:****END     PREP                          OMIT FROM NRLEMP
C:****BEGIN   JLDF(                         OMIT FROM NRLEMP
      FUNCTION JLDF( HLINE)
       Character*16 HIN
      DOUBLE PRECISION HLINE, HLIN1
      DIMENSION HLIN1( 11), JDAT( 11)
C:DIM  HLIN1( 11), JDAT( 11)
      DATA HLIN1/ 6HK     , 6HKA    , 6HKA1   , 6HKB    , 6HKB1   ,
     1 6HLA    , 6HLA1   , 6HLB1   , 6HLB2   , 6HMA    , 6HMA1   /
      DATA JDAT/ 1, 1, 1, 2, 2, 3, 3, 4, 5, 6, 6/
      DO 1 IJ= 1, 11
      IF ( HLINE.EQ. HLIN1( IJ)) GO TO 2
 1    CONTINUE
       JLDF= 0
      RETURN
 2     JLDF= JDAT( IJ)
      RETURN
      END
C:****END     JLDF(                         OMIT FROM NRLEMP
C:****BEGIN   AF(                           OMIT FROM NRLEMP
      FUNCTION AF( NZ, IA)
      DIMENSION JZB( 110), BUF5( 5), JBZ( 20)
C:DIM  JZB( 110), BUF5( 5), JBZ( NO OF ELEMENTS HELD IN BUFFER)
      DIMENSION BUFA( 20, 55)
C:DIM  BUFA( NO OF ELEMENTS HELD IN BUFFER, 55)
      DATA JZB/ 110* 0/
      DATA JBZ/ 20* 0/
      DATA IBB/ 0/
      DATA NZLAST/ 111/
      DATA KOPEN/ 0/
C:----------
      IF ( NZ.LT. 0) GO TO 2
      IF ( NZ.GT. 110) GO TO 99
       IBUFA= JZB( NZ)
      IF ( IBUFA.LE. 0) GO TO 3
 1    IF ( IA.LE. 0) GO TO 99
      IF ( IA.GT. 55) GO TO 99
       AF= BUFA( IBUFA, IA)
      RETURN
C:-------
 2     KRA= IA
      CALL FILIO( KRA, 4, 1, 1, 1)
       KOPEN= 1
      NZLAST= 111
       AF= 0.
      RETURN
C:-------
 3    IF ( KOPEN.LE. 0) GO TO 99
      IF ( NZ.GE. NZLAST) GO TO 4
       REWIND KRA
 4    DO 5  IBUFA= 1, 20
      IF ( JBZ( IBUFA).LE. 0) GO TO 6
 5    CONTINUE
      IF ( IBB.GE. 20) IBB= 0
       IBUFA= IBB+ 1
       IBB= IBUFA
       IBZZ= JBZ( IBB)
       JZB( IBZZ)= 0
 6    DO 7  IJ= 1, 55
 7     BUFA( IBUFA, IJ)= 0.
       JBZ( IBUFA)= 0
      IF ( NZLAST.EQ. NZ) GO TO 9
 8     READ( KRA, 101) NZLAST, IZERO,( BUF5( IJ), IJ= 1, 5)
       NZLAST= NZLAST- 100
      IF ( NZLAST.LT. NZ) GO TO 8
      IF ( NZLAST.GT. NZ) GO TO 11
 9     IZERO= IZERO- 1
      DO 10 IJ= 1, 5
 10    BUFA( IBUFA, IZERO+ IJ)= BUF5( IJ)
      GO TO 8
 11   CONTINUE
       JBZ( IBUFA)= NZ
       JZB( NZ)= IBUFA
       BUFA( IBUFA, 1)= NZ
      GO TO 1
 99    AF= 0.
       KU6= KUF( 6)
       WRITE( KU6, 7702) NZ, IA
 7702 FORMAT( 2X, 4H AF(, I3,1H,, I3,5H)= 0 )
      RETURN
C:-------
 101  FORMAT( I3, I2, 1X, 5E12.5)
      END
C:****END     AF(                           OMIT FROM NRLEMP
C:****BEGIN   WLF(                          OMIT FROM NRLEMP
      FUNCTION WLF( NZI, L)
      DIMENSION JL( 6)
C:DIM  JL( 6)
      DATA JL/ 17, 18, 28, 29, 30, 49/
       IJ= JL( L)
       WLF= AF( NZI, IJ)
      IF ( WLF.EQ. 0.) WLF= 9999.9
      RETURN
C:-------
      END
C:****END     WLF(                          OMIT FROM NRLEMP
C:****BEGIN   WEF(                          OMIT FROM NRLEMP
      FUNCTION WEF( NZI, L)
      DIMENSION JE( 6)
C:DIM  JE( 6)
      DATA JE/ 16, 16, 27, 26, 27, 44/
       IJ= JE( L)
       WEF= AF( NZI, IJ)
      RETURN
C:-------
      END
C:****END     WEF(                          OMIT FROM NRLEMP
C:****BEGIN   FLF(                          OMIT FROM NRLEMP
      FUNCTION FLF( NZI, L, W, KFL)
      DIMENSION ZL12D( 8), FL12D( 8), ZL13D( 8), FL13D( 8)
      DIMENSION ZL23D( 9), FL23D( 9), ZKL1D( 4), FKL1D( 4)
      DIMENSION ZKL2D( 5), FKL2D( 5), ZKL3D( 5), FKL3D( 5)
      DIMENSION ZL1D( 6), WL1D( 6), ZL2D( 5), WL2D( 5)
      DIMENSION ZL3D( 4), WL3D( 4), ZM5D( 11), WM5D( 11)
      DIMENSION ZKBKA( 5), RKBKA( 5)
      DATA ZL12D/ 20., 40., 41., 50., 51., 75., 80., 100./
      DATA FL12D/ .3, .25, .05, .05, .15, .18, .08, .08/
      DATA ZL13D/ 20., 40., 41., 50., 51., 75., 80., 100./
      DATA FL13D/ .6, .6, .7, .7, .3, .3, .6, .6/
      DATA ZL23D/ 0., 20., 29., 30., 40., 55., 90., 95., 100./
      DATA FL23D/ 0., 0., .1, 0., .1, .15, .1, .2, .2/
      DATA ZKL1D/ 20., 40., 60., 100./
      DATA FKL1D/ .25, .1, .02, .02/
      DATA ZKL2D/ 20., 30., 40., 60., 100./
      DATA FKL2D/ .77, .5, .34, .3, .3/
      DATA ZKL3D/ 20., 30., 40., 60., 100./
      DATA FKL3D/ .6, .68, .6, .52, .48/
      DATA ZL1D/ 30., 50., 55., 75., 80., 100./
      DATA WL1D/ 6.91, 4.34, 2.81, 2.04, 2.30, 1.05/
      DATA ZL2D/ 25., 35., 60., 85., 100./
      DATA WL2D/ 6.91, 4.34, 2.04, .916, .223/
      DATA ZL3D/ 20., 40., 60., 100./
      DATA WL3D/ 6.91, 3.51, 1.90, .223/
      DATA ZM5D/ 0., 60., 63., 67., 70., 73., 76., 79.,
     1 83., 86., 90./
      DATA WM5D/ 0., .003, .006, .011, .015, .021, .023, .026,
     1 .033, .036, .050/
      DATA ZKBKA/ 0., 20., 30., 60., 100./
      DATA RKBKA/ .07, .13, .14, .25, .27/
C:----------
       ZZ= NZI
       KFL= 0
       VZ= 0.
       V1= 0.
       V2= 0.
       V3= 0.
       V4= 0.
      IF ( W.LT. 0.) GO TO 20
C:DOC DISTRIBUTION OF PRIMARY VACANCIES FOR X-RAY EXCITATION.
       RJ= 1.
       AF16= AF( NZI, 16)
      IF ( AF16.LE. 0.) GO TO 99
      IF ( W.GT. AF16) GO TO 1
       AF21= AF( NZI, 21)
      IF ( AF21.LE. 0.) GO TO 99
       RJ= RJ/ AF21
       VZ= 1.0- RJ
 1    IF ( L.LT. 3) GO TO 9
       AF25= AF( NZI, 25)
      IF ( AF25.LE. 0.) GO TO 99
      IF ( W.GT. AF25) GO TO 2
       RJ= RJ/ 1.16
       V1= 1.0- RJ
 2     AF26= AF( NZI, 26)
      IF ( AF26.LE. 0.) GO TO 99
      IF ( W.GT. AF26) GO TO 3
       RJ= RJ/ 1.41
       V2= 1.0- RJ
 3     AF27= AF( NZI, 27)
      IF ( AF27.LE. 0.) GO TO 99
      IF ( W.GT. AF27) GO TO 4
       AF41= AF( NZI, 41)
      IF ( AF41.LE. 0.) GO TO 99
       RJ= RJ/ AF41
       V3= 1.0- RJ
 4    IF ( L.LT. 6) GO TO 9
       AF44= AF( NZI, 44)
      IF ( AF44.LE. 0.) GO TO 99
      IF ( W.GT. AF44) GO TO 5
       RJ= RJ/ 1.08
 5     AF45= AF( NZI, 45)
      IF ( AF45.LE. 0.) GO TO 99
      IF ( W.GT. AF45) GO TO 6
       RJ= RJ/ 1.13
 6     AF46= AF( NZI, 46)
      IF ( AF46.LE. 0.) GO TO 99
      IF ( W.GT. AF46) GO TO 7
       RJ= RJ/ 1.34
 7     AF47= AF( NZI, 47)
      IF ( AF47.LE. 0.) GO TO 99
      IF ( W.GT. AF47) GO TO 8
       RJ= RJ/ 1.39
 8     AF48= AF( NZI, 48)
      IF ( AF48.LE. 0.) GO TO 99
      IF ( W.GT. AF48) GO TO 9
       RJ= RJ/( 1.69- .0037* ZZ)
       V4= 1.0- RJ
 9    IF ( RJ.GE. 1.) GO TO 90
91    CONTINUE
C:DOC CHARACTERISTIC-LINE YIELD, GIVEN THE PRIMARY VACANCIES.
      IF ( L.LT. 3) GO TO 10
C:DOC COSTER-KRONIG TRANSITION PROBABILITIES
       FKL1= YXF( ZZ, ZKL1D, FKL1D, 4)
       FKL2= YXF( ZZ, ZKL2D, FKL2D, 5)
       FKL3= YXF( ZZ, ZKL3D, FKL3D, 5)
       FL12= YXF( ZZ, ZL12D, FL12D, 8)
       FL13= YXF( ZZ, ZL13D, FL13D, 8)
       FL23= YXF( ZZ, ZL23D, FL23D, 9)
 10    GO TO( 11, 11, 31, 41, 51, 61), L
C:-------
 11    FA= 0.015+ 0.0327* ZZ- 0.64E-6* ZZ* ZZ* ZZ
      IF ( FA.LE. 0.) GO TO 99
       FA= FA* FA
       FA= FA* FA
       FA= FA/( 1.+ FA)
       RBA= YXF( ZZ, ZKBKA, RKBKA, 5)
      IF ( L.EQ. 1) FA= FA/( 1.+ RBA)
      IF ( L.EQ. 2) FA= FA* RBA/( 1.+ RBA)
       FLF= FA* VZ
      GO TO 95
C:-------
 31    FA= .9* EXP( - YXF( ZZ, ZL3D, WL3D, 4))
      IF ( FA.LE. 0.) GO TO 99
      GO TO 52
 41    FA= EXP( - YXF( ZZ, ZL2D, WL2D, 5))
      IF ( FA.LE. 0.) GO TO 99
       FLF= FA*( V2+ V1* FL12+ VZ* ( FKL2+ FKL1* FL12))
      GO TO 95
C:-------
 51    FA= .1* EXP( - YXF( ZZ, ZL3D, WL3D, 4))
      IF ( FA.LE. 0.) GO TO 99
 52    FLF= FA*( V3+ V2* FL23+ V1*( FL13+ FL12* FL23)
     1 + VZ*( FKL3+ FKL2* FL23+ FKL1*( FL13+ FL12* FL23)))
      GO TO 95
C:-------
 61    FA= YXF( ZZ, ZM5D, WM5D, 11)
       FLF= FA*( V4+ .9*( V3+ V2+ V1+ VZ))
      GO TO 95
C:-------
 90    FLF= 0.
 95   CONTINUE
C:BUG      IF ( FLF.GT. 0.) WRITE( 6,*) NZI, L, W, FLF
      RETURN
C:-------
 99    KFL= 1
      GO TO 90
C:-------
C:DOC DISTRIBUTION OF PRIMARY VACANCIES FOR ELECTRON EXCITATION.
C:DOC  NOTE: THIS APPLIES TO A DISTRIBUTION OF ELECTRON ENERGIES,
C:DOC  WHERE  - W IS THE MAXIMUM ELECTRON ENERGY, IN KEV.
C:DOC TO CONVERT TO SINGLE ENERGY, REPLACE ( UZ* ALOG( UZ)-( UZ- 1.))
C:DOC                                   BY ( ALOG( UZ)/ UZ)
20    CONTINUE
      VEL= ABS( W)
       WEL= 12.398/ VEL
       AF16= AF( NZI, 16)
      IF ( AF16.LE. 0.) GO TO 21
      IF ( WEL.GT. AF16) GO TO 21
      VZ= 1.2*( 0.85+ 0.0047* ZZ)
      UZ= AF16/ WEL
      VZ= VZ*( UZ* ALOG( UZ)-( UZ- 1.))
 21   CONTINUE
       AF25= AF( NZI, 25)
      IF ( AF25.LE. 0.) GO TO 22
      IF ( WEL.GT. AF25) GO TO 22
       V1= 0.61+ 0.0058* ZZ
      UZ= AF25/ WEL
      V1= V1*( UZ* ALOG( UZ)-( UZ- 1.))
 22    AF26= AF( NZI, 26)
      IF ( AF26.LE. 0.) GO TO 23
      IF ( WEL.GT. AF26) GO TO 23
       V2= 0.61+ 0.0058* ZZ
      UZ= AF26/ WEL
      V2= V2*( UZ* ALOG( UZ)-( UZ- 1.))
 23    AF27= AF( NZI, 27)
      IF ( AF27.LE. 0.) GO TO 24
      IF ( WEL.GT. AF27) GO TO 24
       V3= 2.19+ 0.0098* ZZ
      UZ= AF27/ WEL
      V3= V3*( UZ* ALOG( UZ)-( UZ- 1.))
 24   CONTINUE
29    CONTINUE
C:BUG      WRITE( 6, *) WEL, AF16, AF25, AF26, AF27
      CONST= VZ+ V1+ V2+ V3
      IF ( CONST.NE. 0.) CONST= 1./ CONST
      VZ= VZ* CONST
      V1= V1* CONST
      V2= V2* CONST
      V3= V3* CONST
C:BUG      WRITE( 6, *) VZ, V1, V2, V3
      GO TO 91
C:-------
      END
C:****END     FLF(                          OMIT FROM NRLEMP
C:****BEGIN   YXF(                          OMIT FROM NRLEMP
      FUNCTION YXF( X, XT, YT, NT)
      DIMENSION XT( NT), YT( NT)
      IF ( XT( 1).GT. X) GO TO 2
      DO 1 J= 1, NT
      IF ( XT( J).EQ. X) GO TO 6
      IF ( XT( J).GT. X) GO TO 3
    1 CONTINUE
       J1= NT- 1
       J2= NT
      GO TO 4
 2     J1= 1
       J2= 2
      GO TO 4
 3     J1= J- 1
       J2= J
 4     YXF= YT( J1)+ ( YT( J2)- YT( J1))*( X- XT( J1))
     1 /( XT( J2)- XT( J1))
 5    RETURN
C:-------
 6     YXF= YT( J)
      GO TO 5
C:-------
      END
C:****END     YXF(                          OMIT FROM NRLEMP
C:****BEGIN   POINT                         OMIT FROM NRLEMP
      SUBROUTINE POINT( WEMX, NLIN, NEDG, WLIN, WEDG, MNIN)
       Character*16 HIN
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/SPEC1/ NW1, W1( 300), SP1( 300), JSP1( 31), NSP
      DIMENSION WLIN( MNIN), WEDG( MNIN)
C:----------
C:BUG      WRITE( 6, *) NW1
C:BUG      WRITE( 6, *) ( W1( IW), SP1( IW), IW= 1, NW1)
      CALL SORT( WEDG, NEDG+ 0, NEDG, 1)
C*PDP10      CALL SORT( WLIN, NLIN+ 0, NLIN, 1)
	IF( NLIN.GT. 0) CALL SORT( WLIN, NLIN+ 0, NLIN, 1)
C:
C:DOC FIND ALL SIGNIFICANT LINES AND EDGES IN INCIDENT SPECTRA
       NLIN= 0
       NEDGC= 0
      DO 4 ISP= 1, NSP
       IW1= JSP1( ISP)+ 1
       IW2= NW1
      IF ( ISP.LT. NSP) IW2= JSP1( ISP+ 1)
C:BUG      WRITE( 6, *) ISP, IW1, IW2
      DO 1 IW= IW1, IW2
      IF ( SP1( IW).EQ. 0.) GO TO 2
      IF ( SP1( IW).LT. 0.) GO TO 1
      IF ( W1( IW).GT. WEMX) GO TO 1
       NLIN= NLIN+ 1
      IF ( NLIN.GE. MNIN) CALL SORT( WLIN, NLIN+ 0, NLIN, 1)
      IF ( NLIN.GE. MNIN) WRITE( KW, 201) MNIN
      IF ( NLIN.GE. MNIN) NLIN= MNIN
       WLIN( NLIN)= W1( IW)
 1    CONTINUE
C:X      NEDGC= 0
      GO TO 4
C:    -------
C:DOC TAKE EACH SHORT-WAVELENGTH CUTOFF AS AN EDGE
 2     NEDG= NEDG+ 1
       NEDGC= NEDGC+ 1
      IF ( NEDG.GE. MNIN) CALL SORT( WEDG, NEDG+ 0, NEDG, 1)
      IF ( NEDG.GE. MNIN) WRITE( KW, 202) MNIN
      IF ( NEDG.GE. MNIN) NEDG= MNIN
       WEDG( NEDG)= W1( IW)
       IW1= IW+ 1
      IF ( IW1.GT. IW2) GO TO 4
C:DOC FIND EDGES IN INCIDENT SPECTRUM
      DO 3 IW= IW1, IW2
      IF ( W1( IW).GT. WEMX) GO TO 4
      IF ( W1( IW).NE. W1( IW- 1)) GO TO 3
       NEDG= NEDG+ 1
       NEDGC= NEDGC+ 1
      IF ( NEDG.GE. MNIN) CALL SORT( WEDG, NEDG+ 0, NEDG, 1)
      IF ( NEDG.GE. MNIN) WRITE( KW, 202) MNIN
      IF ( NEDG.GE. MNIN) NEDG= MNIN
       WEDG( NEDG)= W1( IW)
 3    CONTINUE
       IW= IW2
      IF ( W1( IW).EQ. WEDG( NEDG)) GO TO 4
       NEDG= NEDG+ 1
       NEDGC= NEDGC+ 1
      IF ( NEDG.GE. MNIN) CALL SORT( WEDG, NEDG+ 0, NEDG, 1)
      IF ( NEDG.GE. MNIN) WRITE( KW, 202) MNIN
      IF ( NEDG.GE. MNIN) NEDG= MNIN
       WEDG( NEDG)= W1( IW)
 4    CONTINUE
C:
C:DOC ORDER THE INCIDENT LINES BY INCREASING WAVELENGTH
C:DOC REMOVE DUPLICATE INCIDENT LINES
 13   CALL SORT( WLIN, NLIN+ 0, NLIN, 1)
C:BUG      WRITE( KW, 7703) NLIN
C:BUG7703  FORMAT( 2X, 22HWLIN( N) FOR N= 1,...,, I3)
C:BUG      WRITE( KW, *) ( WLIN( N), N= 1, NLIN)
      IF ( NEDGC.LE. 0) NEDG= 0
      IF ( NEDG.LE. 1) GO TO 17
C:
C:DOC ORDER THE EDGES BY INCREASING WAVELENGTH
C:DOC REMOVE DUPLICATE EDGES
      CALL SORT( WEDG, NEDG+ 0, NEDG, 1)
C:
C:DOC IGNORE EDGES GREATER THAN WEMX
      DO 14 IEDG= 1, NEDG
      IF ( WEDG( IEDG).GT. WEMX) GO TO 16
 14   CONTINUE
       IEDG= NEDG+ 1
 16    NEDG= IEDG- 1
C:
      IF ( NLIN.GE. MNIN) GO TO 18
 21   IF ( ( NLIN+ 1+ 2* NEDG).GE. MNIN) GO TO 20
 22   CONTINUE
C:BUG      WRITE( KW, 7704) NEDG
C:BUG7704  FORMAT( 2X, 22HWEDG( N) FOR N= 1,...,, I3)
C:BUG      WRITE( KW, *) ( WEDG( N), N= 1, NEDG)
 17   RETURN
C:-------
 18   WRITE( KW, 201) MNIN
       NLIN= MNIN
      GO TO 13
C:-------
 20   WRITE( KW, 202) MNIN
       NEDG= ( MNIN- NLIN- 1)/ 2
      GO TO 22
C:-------
 201  FORMAT( 2X, 41H WARN: NO. OF INCIDENT LINES USED IS ONLY, I4)
 202  FORMAT( 2X, 11H WARN: ONLY, I4, 26H DIV. USED IN INC. SPECTRA)
      END
C:****END     POINT                         OMIT FROM NRLEMP
C:****BEGIN   SORT                          OMIT FROM NRLEMP
      SUBROUTINE SORT( ARRAY, N, NEW, KSORT)
C:DOC TO SORT ARRAY (1 TO N) INTO INCREASING VALUES OF ARRAY
C:DOC IF KSORT NOT ZERO, DUPLICATE VALUES ELIMINATED (N -> NEW)
      DIMENSION ARRAY( N)
      IF ( N.LE. 1) RETURN
      DO 2 I= 1, N
       TEST= ARRAY( I)
      DO 1 I2= I, N
      IF ( TEST.LT. ARRAY( I2)) GO TO 1
       SAVE= ARRAY( I2)
       ARRAY( I2)= TEST
       TEST= SAVE
 1    CONTINUE
 2     ARRAY( I)= TEST
      NEW= N
      IF ( KSORT.EQ. 0) GO TO 4
       K= 1
      DO 3 I= 2, N
      IF ( ARRAY( I).EQ. ARRAY( I- 1)) GO TO 3
       K= K+ 1
       ARRAY( K)= ARRAY( I)
 3    CONTINUE
       NEW= K
 4    RETURN
      END
C:****END     SORT                          OMIT FROM NRLEMP
C:****BEGIN   SPECW                         OMIT FROM NRLEMP
      SUBROUTINE SPECW( NLIN, WLIN, NEDG, WEDG, MNIN)
       Character*16 HIN
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/SPEC1/ NW1, W1( 300), SP1( 300), JSP1( 31), NSP
      COMMON/SPEC2/ NW2, W2( 80), SP2( 300), JSP2( 30), RMESH
      COMMON/MXS/ MNW, MNINT, MNX, MNY, MNEL, MNOL, MNS
      DIMENSION WLIN( MNIN), WEDG( MNIN), WT( 80)
C:DIM  WT( MNIN)
C:XXX
C:----------
C:XXX
       K= NLIN
      IF ( NEDG.LE. 1) GO TO 13
C:
C:DOC ESTABLISH EDGE INTEGRATION-POINTS FOR INCIDENT SPECTRA;
C:DOC FIND QUADRATURE WEIGHTS FOR TRAPEZOIDAL OR SIMPSONS RULE
C:DOC DEPENDING ON DISTANCE BETWEEN EDGES.
      K= K+ 1
      W2( K)= WEDG( 1)
      WT( K)= 0.
      NW2T= NLIN+ NEDG+ NEDG- 2
      NWERR= 0
      WLAST= WEDG( 1)
      DO 5 IEDG= 2, NEDG
      WTEST= WEDG( IEDG)- 0.0001
   17 IF ( NW2T.GT. MNIN- 2) NWERR= NWERR+ 2
      IF ( NW2T.GT. MNIN- 2) GO TO 18
      IF ( WTEST.LE. RMESH* WLAST) GO TO 18
      KSKP= 0
      DELW= RMESH* WLAST- WLAST
      IF (( WLAST+ 2.0* DELW).GT. WTEST) KSKP= 1
      IF ( KSKP.NE. 0) DELW= 0.5*( WTEST- WLAST)
      WTK= DELW/ 3.
      WT( K)= WT( K)+ WTK
      K= K+ 1
      NW2T= NW2T+ 1
      W2( K)= W2( K- 1)+ DELW
      WT( K)= 4.* WTK
      K= K+ 1
      W2( K)= W2( K- 1)+ DELW
      WT( K)= WTK
      WLAST= W2( K)
      IF ( KSKP.NE. 0) GO TO 22
      NW2T= NW2T+ 1
      GO TO 17
   18 CONTINUE
      WTK=( WTEST- WLAST)/ 2.
      WT( K)= WT( K)+ WTK
      K= K+ 1
      W2( K)= WTEST
      WT( K)= WTK
   22 IF ( IEDG.GE. NEDG) GO TO 5
      K= K+ 1
      W2( K)= WEDG( IEDG)+ 0.0001
      WT( K)= 2.0* 0.0001
      WLAST= W2( K)
 5     CONTINUE
      NWERR= K+ NWERR
      IF ( K.NE. NWERR) WRITE( KW, 601) K, NWERR
  601 FORMAT( 2X,11HWARN: USING, I3,3H OF, I4,20H PTS IN LAMBDA GRID.)
 13    NW2= K
      DO 16 ISP= 1, NSP
   16 JSP2( ISP)=( ISP- 1)* NW2
      IF ( NLIN.LT. 1) GO TO 14
C:DOC
C:DOC ESTABLISH POINTS AND INTEGRAND FOR LINES
      DO 4 L= 1, NLIN
       WX= WLIN( L)
       W2( L)= WX
      DO 3 ISP= 1, NSP
       III= ( ISP- 1)* NW2
C:XXX
       IIIL= III+ L
      IF ( IIIL.GT. MNW) GO TO 9902
       SP2( IIIL)= 0.
       IW1= JSP1( ISP)+ 1
       IW2= NW1
      IF ( ISP.LT. NSP) IW2= JSP1( ISP+ 1)
      DO 1 IW= IW1, IW2
      IF ( SP1( IW).EQ. 0) GO TO 3
      IF ( SP1( IW).LT. 0.) GO TO 1
      IF ( W1( IW).EQ. WX) GO TO 2
 1    CONTINUE
      GO TO 3
C:    -------
 2     SP2( IIIL)= SP1( IW)
 3    CONTINUE
 4    CONTINUE
 14   IF ( NEDG.LE. 1) GO TO 15
C:
C:DOC ESTABLISH INTEGRAND VALUES FOR EDGE POINTS
      DO 11 ISP= 1, NSP
       IW1= JSP1( ISP)+ 1
       IW2= NW1
      IF ( ISP.LT. NSP) IW2= JSP1( ISP+ 1)
      DO 6 IW= IW1, IW2
      IF ( SP1( IW).EQ. 0.) GO TO 7
 6    CONTINUE
       IW= IW2+ 1
 7     IW1= IW
       K1= NLIN+ 1
      DO 10 K= K1, NW2
       WX= W2( K)
       IWK= JSP2( ISP)+ K
      IF ( IWK.GT. MNW) GO TO 9902
       SP2( IWK)= 0.
      IF ( IW1.GE. IW2) GO TO 10
      IF ( W1( IW1).GT. WX) GO TO 10
      DO 8 IW= IW1, IW2
      IF ( W1( IW).GT. WX) GO TO 9
 8    CONTINUE
      GO TO 10
C:    -------
9     CONTINUE
      IF (( SP1( IW)* SP1( IW-1)).GT. 0.) GO TO 19
       D= ( SP1( IW)- SP1( IW- 1))*
     1 ( WX- W1( IW- 1))/( W1( IW)- W1( IW- 1))
       SP2( IWK)= WT( K)*( SP1( IW- 1)+ D)
      GO TO 10
C:    -------
19     D=( ALOG( SP1( IW))- ALOG( SP1( IW- 1)))*
     1 ( WX- W1( IW- 1))/( W1( IW)- W1( IW- 1))
       SP2( IWK)= WT( K)* EXP2F( -23., ( ALOG( SP1( IW- 1))+ D))
 10   CONTINUE
 11   CONTINUE
 15   RETURN
C:-------
 9902 CONTINUE
      WRITE( KW, 9903) MNW
 9903 FORMAT(20H ERROR: NO MORE THAN, I4,21H INCIDENT INTENSITIES,
     1  16H MAY BE TREATED./37H   USE 'CONDITIONS' AND THEN 'LINES'.)
      CALL ERROR( 0)
      GO TO 15
C:------------
      END
C:****END     SPECW                         OMIT FROM NRLEMP
C:****BEGIN   ITER      OMIT FROM NRLSIM
      SUBROUTINE ITER( NFREE, KONIT, NIT, NY, NX, JZY, YC,
     1 YU, XU, XG, DX, BX, DBX, NEL, RERR, LIMIT)
       Character*16 HIN
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
      COMMON/GB/ GAM( 30, 21), BET( 30, 21), GG( 22, 22)
      DIMENSION YDY( 30), DY( 30),
     1 ROS( 30), SIGY( 30), VEC( 21), SUMB( 20), DD( 21, 30),
     1 RDD( 21, 30), GII( 20)
C:DIM  YDY( MNY), DY( MNY), RDD( MNX+ 1, MNY), GII( MNX)
      DIMENSION JZY( NY), XU( NX), YC( NY), YU( NY), XG( NX)
      DIMENSION RERR( NY), DX( NX), BX( NX), DBX( NX)
      DIMENSION ROOT( 21), YCOLD( 30)
C:DIM  ROOT( MNX+ 1), YCOLD( MNY)
      DATA TOLX/ .0005/, TOLY/ .2/
C:DOC TO CONVERGE IN AMOUNTS, REL. DIFF. IN SUCCESSIVE ESTIMATES
C:DOC   OF XU MUST NOT EXCEED TOLX.
C:DOC TO CONVERGE IN INTENSITIES, REL. DIFF. BETWEEN MEASURED AND
C:DOC   INTERPOLATED VALUES MUST NOT EXCEED  TOLY* RERR.
C:
C:----------
      DO 62 IX= 1, NX
      DX( IX)= 0.
   62 BX( IX)= 0.
       NX1= NX+ 1
       NX2= NX1+ 1
       K2= 1
      IF ( KOP.EQ. 1) K2= 2
      IF ( KONIT.EQ. 1) NIT= 0
      IF ( NIT.EQ. 0) GO TO 80
      IF ( KONIT.EQ. 2) GO TO 826
      IF ( KONIT.NE. 1) KONIT= 0
      IF ( KONIT.EQ. 0) RETURN
C:BUG      WRITE( 6, *) NIT, KONIT
      RETURN
C:-------
 80   CONTINUE
       NXIND= NX
       CON= 1.
      IF ( XUS.GT. 0.) CON= XUS
       CON= CON/ FLOAT( NX)
      DO 81 N= 1, NX
       ROOT( N)= CON
      IF ( XG( N).GE. 0.) NXIND= NXIND- 1
   81 CONTINUE
       NFREE= 0- NXIND
      IF ( XUS.GT. 0.) NFREE= NFREE+ 1
      DO 90 IY= 1, NY
      IF ( YU( IY).GE. 0.) NFREE= NFREE+ 1
   90 CONTINUE
      IF ( NFREE.LT. 0) GO TO 9999
       KEST= 0
 826  CONTINUE
C:MOD  BEGIN                                OMIT FROM NRLEMP
      IF ( KOP.NE. 1) CALL  ADJB( NIT, NX, NY, YU, JZY, NEL)
C:MOD  END                                  OMIT FROM NRLEMP
      IF ( KOP.EQ. 1)
     1 CALL  GAMBS( NIT, NX, NY, XU, YU, JZY)
 68   CALL SETA1( XU, ROOT, NX)
C:ALT      IF ( NIT.GT. 3) GO TO 70
      IF ( KOP.NE. 4) GO TO 70
      DO 72 IX= 1, NX
      IF ( ROOT( IX).EQ. 0.) ROOT( IX)= 1.E-30
   72 CONTINUE
 70   DO 920 KOUNT= 1, K2
      DO 73 N= 1, NX
C:ALT      IF ( ROOT( N).LT. 0.) ROOT( N)= 0.
       VEC( N)= 0.
      DO 73 IX= 1, NX
   73  GG( N, IX)= 0.
      CALL YBAR( ROOT, NX, YC, NY)
      DO 804 IY= 1, NY
      IF ( YU( IY).LT. 0.) GO TO 804
       WW= 1.
       RCA= BET( IY, NX1)
      DO 71 IX= 1, NX
       RCA= RCA+ ROOT( IX)* BET( IY, IX)
   71 CONTINUE
       YUIY= YU( IY)
       YCIY= YC( IY)
      IF ( KEST.EQ. 0) YCIY= YUIY
       SIGY( IY)= RERR( IY)*( YUIY         )
      IF ( SIGY( IY).EQ. 0.) SIGY( IY)= RERR( IY)
       DENOM= RCA* SIGY( IY)
      IF ( DENOM.NE. 0.) WW= 1./ DENOM** 2
       ROS( IY)= RCA* WW
      DO 803 N= 1, NX
      IF ( XG( N).GE. 0.) GO TO 803
       CON= WW*( GAM( IY, N)- YCIY* BET( IY, N))
      DO 802 IX= 1, NX
  802  GG( N, IX)= GG( N, IX)+ CON*( GAM( IY, IX)- YCIY* BET( IY, IX))
       VEC( N)= VEC( N)- CON*( GAM( IY, NX1)- YCIY* BET( IY, NX1))
     1  - CON* ( YCIY- YUIY)* RCA
  803 CONTINUE
  804 CONTINUE
C:
      DO 86 N= 1, NX
       GG( N, NX1)= 1.
       GG( NX1, N)= 1.
      IF ( XG( N).GE. 0.) GO TO 84
      IF ( KOP.EQ. 1) GO TO 86
      IF ( ROOT( N).LE. 0.) GO TO 83
      GO TO 86
C:-------
 83    VEC( N)= 0.
      GO TO 85
C:-------
 84    VEC( N)= XG( N)
 85   CONTINUE
      DO 87 IXX= 1, NX1
 87    GG( N, IXX)= 0.
       GG( N, N)= 1.
   86  GII( N)= GG( N, N)
       GG( NX1, NX1)= 0.
      IF ( XUS.GT. 0.) VEC( NX1)= XUS
      IF ( XUS.GT. 0.)
     1 CALL SOLV( NX1, 1, GG, MNX+ 2, VEC, MNX+ 1, ROOT, MNX+ 1, KW, IK)
      IF ( XUS.LE. 0.)
     1 CALL SOLV( NX, 1, GG, MNX+ 2, VEC, MNX+ 1, ROOT, MNX+ 1, KW, IK)
      IF ( XUS.GT. 0.) CALL NORM( ROOT, NX, XUS, XMULT)
C:BUG      WRITE( 6, 6601) ( ROOT( IX), IX= 1, NX)
      DO 914 IX= 1, NX
      IF ( ABS( ROOT( IX)).LE. 1.E-30) ROOT( IX)= 0.
      IF ( KOP.EQ. 1) GO TO 914
      IF ( ROOT( IX).LT. 0.) GO TO 70
  914 CONTINUE
       KEST= 1
 920  CONTINUE
       NIT= NIT+ 1
      IF ( NIT.LE. 1) GO TO 915
      IF ( NIT.GE. LIMIT) KONIT= 5
       KONVX= 0
      DO 929 IX= 1, NX
       XTEST= TOLX* 0.5*( XU( IX)+ ROOT( IX))
       XTEST= ABS( XTEST)
      IF ( ABS( XU( IX)- ROOT( IX)).GT. XTEST) KONVX= 1
  929 CONTINUE
      IF ( KONVX.EQ. 0) KONIT= 3
 915  CONTINUE
C:BUG      IF (( KONIT.EQ. 2).AND.( NIT.GT. 1))
C:BUG     1 WRITE( KW, *)( XU( J), J= 1, NX)
C:BUG      IF ( KONIT.EQ. 2) WRITE( KW, *) ROOT( NX1)
      CALL SETA1( XU, ROOT, NX)
C:BUG      WRITE( 6, 6601) ( XU( IX), IX= 1, NX)
C:BUG6601  FORMAT( 2X, 2X, 8F7.4)
      CALL YBAR( XU, NX, YC, NY)
      IF ( NIT.LE. 1) GO TO 94
      IF ( NFREE.LE. 0) GO TO 94
      IF ( KONIT.EQ. 3) GO TO 93
      KONVY= 0
      DO 92 IY= 1, NY
      IF ( YU( IY).LT. 0.) GO TO 92
       YTEST= TOLY* RERR( IY)* 0.5*( YCOLD( IY)+ YC( IY))
       YTEST= ABS( YTEST)
      IF ( ABS( YC( IY)- YCOLD( IY)).GT. YTEST) KONVY= 1
   92 CONTINUE
      IF ( KONVY.EQ. 0) KONIT= 4
 94   CALL SETA1( YCOLD, YC, NY)
      IF ( KONIT.EQ. 1) GO TO 826
 93   IF ( KOUT.EQ. 1) GO TO 99
      IYD= 0
      DO 705 IY= 1, NY
      IF ( YU( IY).LT. 0.) GO TO 705
      IYD= IYD+ 1
      IF ( ABS( YC( IY)).LT. 1.E-30) YC( IY)= 0.
       DY( IY)= YU( IY)- YC( IY)
       YDY( IY)= YU( IY)+ DY( IY)
      DO 704 IX= 1, NX
       DD( IX, IYD)= 0.
      IF ( XG( IX).GE. 0.) GO TO 704
      IF ( XU( IX).EQ. 0.) GO TO 704
       DD( IX, IYD)=
     1 ROS( IY)*( GAM( IY, IX)- BET( IY, IX)* YDY( IY))
  704 CONTINUE
       DD( NX1, IYD)= 0.
705   CONTINUE
      IF ( XUS.GT. 0.)
     1 CALL SOLV( NX1, NY, GG, MNX+ 2, DD, MNX+ 1, RDD, MNX+ 1, KW, IK)
      IF ( XUS.LE. 0.)
     1 CALL SOLV( NX, NY, GG, MNX+ 2, DD, MNX+ 1, RDD, MNX+ 1, KW, IK)
      DO 702 IX= 1, NX
       BX( IX)= 0.
       SUMB( IX)= 0.
C:ALT       DBX( IX)= 0.
  702  DX( IX)= 0.
      IYD= 0
      DO 710 IY= 1, NY
      IF ( YU( IY).LT. 0.) GO TO 710
      IYD= IYD+ 1
      DO 706 IX= 1, NX
      IF ( XG( IX).GE. 0.) GO TO 706
      IF ( XU( IX).EQ. 0.) GO TO 706
       DXDY= RDD( IX, IYD)
      IF ( ABS( DXDY).LT. 1.E-30) DXDY= 0.
       DX( IX)= DX( IX)+ ( DXDY* SIGY( IY))** 2
       DXDY=( GAM( IY, IX)- BET( IY, IX)* YDY( IY))
     1 * ROS( IY)/ GII( IX)
C:ALT       DBX( IX)= DBX( IX)+( DXDY* SIGY( IY))** 2
       BX( IX)= BX( IX)+ DXDY* DY( IY)
      IF ( GAM( IY, IX).EQ. 0.) DXDY= 0.
      IF ( GAM( IY, IX).EQ. 0.) GO TO 706
C:ALT      BX( IX)= BX( IX)+( ROS( IY)* SIGY( IY))** 2
C:ALT     1  *( GAM( IY, IX)- BET( IY, IX)* YU( IY))
C:ALT     1  ** 2
       SUMB( IX)= SUMB( IX)- ROS( IY)* DY( IY)
     1 *( GAM( IY, IX)- BET( IY, IX)* YC( IY))
  706 CONTINUE
  710 CONTINUE
      DO 708 IX= 1, NX
      IF ( XG( IX).GE. 0.) GO TO 708
      IF ( XU( IX).EQ. 0.) GO TO 708
C:ALT       DBX( IX)= SQRT( DBX( IX))
C:ALT     BX( IX)= ( 1.0- XU( IX))*SUMB( IX)/( SUMB( IX)- BX( IX))
       DX( IX)= SQRT( DX( IX))
C:BUG      WRITE( KW, *) DX( IX)
 708  CONTINUE
      RETURN
C:-------
 9999  KONIT= -1
 99   RETURN
C:-------
      END
C:****END     ITER      OMIT FROM NRLSIM
C:****BEGIN   DOTF(                         OMIT FROM NRLEMP
      FUNCTION DOTF( A, B, N)
      DIMENSION A( N), B( N)
       SUM= 0.
      DO 1 I= 1, N
 1     SUM= SUM+ A( I)* B( I)
       DOTF= SUM
      RETURN
C:-------
      END
C:****END     DOTF(                         OMIT FROM NRLEMP
C:****BEGIN   NORM
      SUBROUTINE NORM( X, N, SUM, XM)
      DIMENSION X( N)
       XM= 0.
      DO 1 I= 1, N
 1     XM= XM+ X( I)
      IF ( XM.NE. 0.) XM= SUM/ XM
      DO 2 I= 1, N
 2     X( I)= XM* X( I)
      RETURN
C:-------
      END
C:****END     NORM
C:****BEGIN   SETA1     OMIT FROM NRLSIM
      SUBROUTINE SETA1( A, B, N)
      DIMENSION A( N), B( N)
C:----------
      DO 1 I= 1, N
 1     A( I)= B( I)
      RETURN
C:-------
      END
C:****END     SETA1     OMIT FROM NRLSIM
C:****BEGIN   EXP2F(                        OMIT FROM NRLEMP
      FUNCTION EXP2F( XTEST, X)
      IF ( X.LT. XTEST) GO TO 1
       EXP2F= EXP( X)
      RETURN
C:-------
 1     EXP2F= 0.
      RETURN
C:-------
      END
C:****END     EXP2F(                        OMIT FROM NRLEMP
C:****BEGIN   ADJB      OMIT FROM NRLSIM    OMIT FROM NRLEMP
      SUBROUTINE ADJB( NIT, NX, NY, YU, JZY, NEL)
       Character*16 HIN
      DOUBLE PRECISION HSAMP, HXS, HXU
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/GB/ GAM( 30, 21), BET( 30, 21), GG( 22, 22)
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMX/ HXS( 51, 20), X1( 51, 20, 2)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
      COMMON/LMC/ PURE( 30), ROMZ( 30), YY( 30)
      DIMENSION XC( 20), YU( NY), JZY( NY)
      DIMENSION YSIM( 30), YC( 30), CC( 20), XD1( 20), XD2( 20)
C:DIM  YSIM( MNY), YC( MNY), CC( NX)
C:----------
       NX1= NX+ 1
       K2= 1
       NS3= NX+ 1
      IF ( KADJB.NE. 0) GO TO 9
      IF ( KOP.NE. 4) GO TO 30
C:ALT      IF ( NIT.GT. 3) GO TO 30
      IF ( NIT.LE. 0) GO TO 47
C:ALT       NSTD1= NS1+ NS2+ 2
C:ALT      IF ( NS1.LE. 0) NS3= 3
      IF (( NS1+ K2* NX+ 1+ NS3).GT. MNS) NS3= MNS- NS1- K2* NX- 1
      IF ( NSTD.LT. NS1+ K2* NX+ 1+ NS3) GO TO 50
C:BUG      WRITE( 6, 601) NSTD1
       IS1= NS1+ K2* NX+ 1+ 1
       IS2= IS1+ NS3- 1
      IF ( IS1.GE. IS2) GO TO 35
      DO 36 IS= IS1, IS2
      DO 32 IX= 1, NX
 32    X1( IS, IX, 1)= X1( IS+ 1, IX, 1)
      DO 33 IY= 1, NY
 33    Y1( IS, IY)= Y1( IS+ 1, IY)
 36   CONTINUE
 35    NSTD= NSTD- 1
C:BUG      WRITE( 6, 601) NSTD, ( X1( NSTD, II, 1), II= 1, NX),
C:BUG     1  ( Y1( NSTD, II), II= 1, NY)
 50    IF ( NSTD+ 1.GT. MNS) GO TO 48
       NSTD= NSTD+ 1
      IF ( NIT.LE. 0) GO TO 34
 30   IF ( NIT.LE. 0) GO TO 47
 34   CALL SETA1( XC, XU, NX)
      CALL XSAMP( JSR, XD1, XD2, NX, 0)
      IF ( KIND.NE. 3) CALL NORM( XC, NX, 1., XMULT)
C:ALT IF (( KOP.NE. 4).OR.( NIT.GT. 3)) CALL YBAR( XC, NX, YC, NY)
      IF (( KOP.NE. 4)) CALL YBAR( XC, NX, YC, NY)
      CALL XTOC( CC, NEL, XC, NX)
      CALL SIM( XC, NX, YSIM, NY, CC, NEL)
      DO 804 IY= 1, NY
       IZ= JZY( IY)
       YSIM( IY)= CC( IZ)* YSIM( IY)
      IF ( KIND.EQ. 3) YSIM( IY)= YSIM( IY)/ PURE( IY)
      IF ( KOP.NE. 4) GO TO 12
C:ALT      IF ( NIT.GT. 3) GO TO 12
C:ALT      IF ( NS1.LE. 1) YSIM( IY)= YSIM( IY)/ XMULT
C:ALT??       YSIM( IY)= YSIM( IY)/ XMULT
       Y1( NSTD, IY)= YSIM( IY)
       YE( NSTD, IY)= -0.01
      GO TO 804
 12    CON= 1.
      IF ( YSIM( IY).GT. 0.) CON= YC( IY)/ YSIM( IY)
      DO 16 IX= 1, NX1
 16    BET( IY, IX)= CON* BET( IY, IX)
  804 CONTINUE
C:ALT      IF ( NIT.GT. 3) GO TO 47
      IF ( KOP.NE. 4) GO TO 47
C:ALT      IF ( NS1.LE. 1) CALL SETA1( XC, XU, NX)
C:ALT??       CALL SETA1( XC, XU, NX)
       PS( NSTD, 1)= NX
       SUM= 0.
      DO 31 IXS= 1, NX
C:ALT       HXS( NSTD, IXS)= HXU( IXS)
       SUM= SUM+ XC( IXS)
 31    X1( NSTD, IXS, 1)= XC( IXS)
       PS( NSTD, 5)= SUM
C:BUG      WRITE( 6, 601) NSTD, ( XU( IXS), IXS= 1, NX),
C:BUG     1  ( YSIM( IYS), IYS= 1, NY)
       KADJB= 0
 47   CONTINUE
      IF ( KOP.EQ. 3) GO TO 99
C:ALT      IF ( NIT.GT. 3) GO TO 99
      CALL  GAMBS( NIT, NX, NY, XU, YU, JZY)
      GO TO 99
C:-------
 9    IF ( KOP.EQ. 4) GO TO 40
      DO 1 IY= 1, NY
       GAM( IY, NX1)= 0.
       BET( IY, NX1)= 1.
 1    CONTINUE
      CALL XSAMP( JSR, XD1, XD2, NX, 0)
      DO 4 IX= 1, NX
      IF ( KIND.EQ. 3) GO TO 8
      DO 2 IX2= 1, NX
    2 XC( IX2)= 0.
      XC( IX)= 1.
      CALL XTOC( CC, NEL, XC, NX)
      CALL SIM( XC, NX, YSIM, NY, CC, NEL)
 8    DO 3 IY= 1, NY
       BET( IY, IX)= 0.
       IZ= JZY( IY)
       GAM( IY, IX)= PELC( IZ, IX)
       BET( IY, IX)= 0.
      IF ( KIND.EQ. 3) GO TO 3
      IF ( YSIM( IY).GT. 0.) BET( IY, IX)= 1./ YSIM( IY)- 1.
 3    CONTINUE
    4 CONTINUE
       CON= 1./ FLOAT( NX)
      DO 5 IX= 1, NX
    5  XU( IX)= CON
      IF ( KIND.EQ. 3) CALL NORM( XU, NX, 1.E-6, XMULT)
       KADJB= 0
      GO TO 30
C:-------
 40    NS2= 0
      IF (( NS1+ K2* NX+ 1).LE. MNS) GO TO 43
 48   WRITE( KW, 207)
 207  FORMAT( 2X, 27HERROR: NOT ENOUGH SPACE FOR,
     1 21H SIMULATED STANDARDS.)
      IF (( NS1+ K2* NX+ 1).GT. MNS) CALL ERROR( 0)
      GO TO 99
C:-------
 43    XADD= 1./ FLOAT( NX+ 2)
C:ALT      IF ( NS1.LT. NY) K2= 1
C:ALT      IF ( K2.LT. 1) GO TO 41
      CALL XSAMP( JSR, XD1, XD2, NX, 0)
      DO 46 KOUNT= 1, K2
C:ALT       FKI= 1./ FLOAT( NX+ KOUNT- 2)
       FKI= 1./ FLOAT( KOUNT* NX- 1)
      DO 44 IX= 1, NX
       SXC= 0.
      DO 42 IX2= 1, NX
       XC( IX2)= XADD
 42    SXC= SXC+ XADD
       XC( IX)= 1.- SXC
      IF ( KOUNT.GE. 2) XC( IX)= ( SXC- XADD)* FKI
      IF ( KIND.NE. 3) CALL NORM( XC, NX, 1., XMULT)
      IF ( KIND.EQ. 3) CALL NORM( XC, NX, 1.E-6, XMULT)
      CALL XTOC( CC, NEL, XC, NX)
      CALL SIM( XC, NX, YSIM, NY, CC, NEL)
       NS2= NS2+ 1
       NSTD= NS1+ NS2
       PS( NSTD, 1)= NX
       SUM= 0.
      DO 21 IXS= 1, NX
C:ALT       HXS( NSTD, IXS)= HXU( IXS)
       SUM= SUM+ XC( IXS)
 21    X1( NSTD, IXS, 1)= XC( IXS)
       PS( NSTD, 5)= SUM
      DO 22 IYS= 1, NY
       IZ= JZY( IYS)
       YSIM( IYS)= CC( IZ)* YSIM( IYS)
      IF ( KIND.EQ. 3) YSIM( IYS)= YSIM( IYS)/ PURE( IYS)
       Y1( NSTD, IYS)= YSIM( IYS)
       YE( NSTD, IYS)= -0.01
 22   CONTINUE
C:BUG      WRITE( 6, 601) NSTD, ( XC( IXS), IXS= 1, NX),
C:BUG     1  ( YSIM( IYS), IYS= 1, NY)
C:BUG601   FORMAT( 2X, I3, 8F7.4/ 4X, 8F7.4/ 4X, 8F7.4/ 4X, 8F7.4)
   44 CONTINUE
 46   CONTINUE
 41    NSTD= NS1+ NS2
      CALL  GAMBS( -1, NX, NY, XU, YU, JZY)
       CON= 1./ FLOAT( NX)
      DO 45 IX= 1, NX
   45  XU( IX)= CON
      IF ( KIND.EQ. 3) CALL NORM( XU, NX, 1.E-6, XMULT)
      GO TO 50
C:-------
 99   CONTINUE
      RETURN
      END
C:****END     ADJB      OMIT FROM NRLSIM    OMIT FROM NRLEMP
C:****BEGIN   GAMBS     OMIT FROM NRLSIM
      SUBROUTINE GAMBS( KGB, NX, NY, XU, YU, JZY)
       Character*16 HIN
      DOUBLE PRECISION HSAMP
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
      COMMON/GB/ GAM( 30, 21), BET( 30, 21), GG( 22, 22)
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      DIMENSION XU( NX), YU( NY), JZY( NY)
      DIMENSION SSTD( 51), WSTD( 51), G2( 22), RR( 22), NUM( 21)
C:DIM  SSTD( MNS), WSTD( MNS), G2( MNX+ 2), RR( MNX+ 2), NUM( MNX+ 1)
      DIMENSION XC( 20), YC( 30), RELER( 30), YMULT( 30)
C:DIM  XC( MNX), YC( MNY), RELER( MNY), YMULT( MNY)
C:----------
       NX1= NX+ 1
       NX2= NX1+ 1
C:ALT      IF ( NS1.GT. 0) NSTD1= NS1+ 1
      IF ( KGB.LT. 0) GO TO 1
      IF ( KGB.EQ. 0) GO TO 20
      IF ( NSTD.EQ. NS1) GO TO 99
      GO TO 20
C:
C:DOC THE GAMMAS AND BETAS ARE CALCULATED FOR EACH MEASURED
C:DOC QUANTITY SEPARATELY; SEE LOOP   DO 100 IY= 1, NY
C:
C:DOC GAMMAS ARE SET IN LOOPS  DO 4  AND  DO 8
C:
C:DOC FOR EACH IY, WE MINIMIZE THE SUM (OVER ALL STANDARDS) OF
C:DOC   SQUARED ERRORS IN FITTED AND MEASURED VALUES, TIMES
C:DOC   THE SQUARE OF SUM (OVER COMPONENTS) OF GAM* XSTD.
C:DOC THUS THE TERMS IN THE SUM ARE OF ORDER Y(FIT)-Y(STD).
C:
C:
C:-------
 1    CONTINUE
      DO 4 IX= 1, NX
      DO 3 IY= 1, NY
       BET( IY, IX)= 0.
       IZ= JZY( IY)
       GAM( IY, IX)= PELC( IZ, IX)
 3    CONTINUE
    4 CONTINUE
      DO 8 IY= 1, NY
       GAM( IY, NX1)= 0.
 8     BET( IY, NX1)= 1.
       CON= 1./ FLOAT( NX)
      DO 5 IX= 1, NX
    5  XU( IX)= CON
      IF ( KOP.EQ. 1) CALL ADJB1( NX, NY)
      GO TO 99
C:-------
 20   CONTINUE
       IS1= 2
       IS2= NS1
      IF ( KOP.EQ. 4) IS1= NS1+ 1
      IF ( KOP.EQ. 4) IS2= NSTD
      IF ( KGB.EQ. 0) IS1L= 2
      CALL SSTDS( 2+ KGB, XC, NX, 1, YU, NY, SSTD, IS1L, NSTD, YMULT)
      IS1L= NSTD
      IF ( KOP.NE. 4) GO TO 30
      IF ( KGB.GT. 0) GO TO 30
       KSSTD= 0
      DO 26 IY= 1, NY
      IF ( YE( JSR, IY).GT. 0.) GO TO 26
       YU( IY)= Y1( JSR, IY)* YMULT( IY)
       KSSTD= 1
26    CONTINUE
      IF ( KSSTD.EQ. 0) GO TO 30
      CALL SSTDS( 2, XC, NX, 1, YU, NY, SSTD, 2, NSTD, YMULT)
C:
30    CONTINUE
C:BUG      WRITE( 6, *) IS1, IS2
C:BUG      WRITE( 6, *) ( SSTD( IS), IS= IS1, IS2)
      DO 100 IY= 1, NY
      DO 70 IX= 1, NX
   70 NUM( IX)= 0
      NUM( NX1)= 1
      NSIY= 0
C:--  EVALUATE WEIGHTING FACTORS FOR MEASUREMENT IY
 29   DO 32 IS= IS1, IS2
       WSTD( IS)= 0.
      IF ( SSTD( IS).LE. 0.) GO TO 32
      IF ( Y1( IS, IY).LT. 0.) GO TO 32
       SGX= GAM( IY, NX1)
      DO 31 IX= 1, NX
      XISIX= XSF( IS+ 0, IX+ 0)
      IF ( XISIX.GT. 0.) NUM( IX)= NUM( IX)+ 1
 31    SGX= SGX+ GAM( IY, IX)* XISIX
       SZ2= .0001+ YE( IS, IY)**2
      IF ( SGX.NE. 0.) WSTD( IS)= 1./(( 0.01+ SSTD( IS)+ SZ2)* SGX**2)
      IF ( WSTD( IS).GT. 0.) NSIY= NSIY+ 1
 32   CONTINUE
C:BUG      WRITE( KW, *) IS1, IS2
C:BUG      WRITE( KW, 204) ( WSTD( IS), IS= IS1, IS2)
C:--  INITIALIZE ARRAYS GG AND G2 TO ZERO
      DO 34 IX= 1, NX2
      DO 33 IJX= 1, NX2
 33    GG( IX, IJX)= 0.
 34    G2( IX)= 0.
C:--  FOR EACH STANDARD, ADD ITS TERM TO ARRAYS GG AND G2
C:>>> GAM( IY, NX1) IS BEING SET TO 0.
      DO 48 IS= IS1, IS2
      IF ( WSTD( IS).LE. 0.) GO TO 48
      IF ( Y1( IS, IY).LT. 0.) GO TO 48
       YISIY= Y1( IS, IY)
      IF ( YE( IS, IY).LE. 0.) YISIY= YISIY* YMULT( IY)
       WW= WSTD( IS)
       WWY= WW* YISIY
      DO 46 IX= 1, NX1
       XISIX= 1.
      IF ( IX.LE. NX) XISIX= XSF( IS+ 0, IX+ 0)
       WWX= WW* XISIX
       WWXY= WWY* XISIX
      DO 41 IJX= 1, NX1
       XISJX= 1.
      IF ( IJX.LE. NX) XISJX= XSF( IS+ 0, IJX+ 0)
       WWXXY= WWXY* XISJX
       GG( IX, IJX)= GG( IX, IJX)+ WWXXY* YISIY
 41    G2( IX)= G2( IX)+ GAM( IY, IJX)* WWXXY
       G2( IX)= G2( IX)- GAM( IY, NX1)* WWXXY
C:ALT46    GG( IX, NX2)= GG( IX, NX2)- WWXXY
 46   CONTINUE
       WWX= WW
       WWXY= WWY
C:ALT     DO 43 IJX= 1, NX1
C:ALT      XISJX= 1.
C:ALT     IF ( IJX.LE. NX) XISJX= XSF( IS+ 0, IJX+ 0)
C:ALT      GG( NX2, IJX)= GG( NX2, IJX)+ WWXY* XISJX
C:ALT      GG( NX2, IJX)= 0.
C:ALT43    G2( NX2)= G2( NX2)+ GAM( IY, IJX)* WWX* XISJX
C:ALT      G2( NX2)= G2( NX2)- GAM( IY, NX1)* WWX
C:ALT      G2( NX2)= 0.
C:ALT      GG( NX2, NX2)= GG( NX2, NX2)- WWX
C:ALT      GG( NX2, NX2)= 1.
 48   CONTINUE
C:--
C:--  SET PARTICULAR VALUES OF BET= 0. IF INDETERMINATE
      NBSZ= 0
      DO 44 IX= 1, NX1
      IF ( NUM( IX).LE. 0) GO TO 71
       SUM= 0.
C:ALT     DO 42 IJX= 1, NX2
      DO 42 IJX= 1, NX1
 42    SUM= SUM+ ABS( GG( IX, IJX))
      IF ( SUM.GT. 0.) GO TO 44
   71 DO 72 IJX= 1, NX2
   72 GG( IX, IJX)= 0.
       GG( IX, IX)= 1.
C:ALT      GG( IX, NX2)= 0.
       G2( IX)= 0.
      NBSZ= NBSZ+ 1
      WRITE( KW, 304) IY, IX
  304 FORMAT( 2X, 11HWARN: BETA(, I2, 1H,, I2, 10H) SET = 0.)
 44   CONTINUE
C:DOC IF BZ> 0, SET BET( IY, IXMX)= 0; IXMX IS FOR LARGEST GAM
      IF ( BZ.LT. 0.) GO TO 45
       GMX= 0.
       IXMX= 0
      DO 51 IX= 1, NX
      IF ( GAM( IY, IX).LE. GMX) GO TO 51
       GMX= GAM( IY, IX)
       IXMX= IX
 51   CONTINUE
C:ALT     DO 47 IJX= 1, NX2
      DO 47 IJX= 1, NX1
 47    GG( IXMX, IJX)= 0.
       GG( IXMX, IXMX)= 1.
       G2( IXMX)= 0.
 45   CONTINUE
      NXT= NX
      IF ( BZ.LT. 0.) NXT= NX+ 1
      IF ( NSIY.GE.( NXT- NBSZ)) GO TO 73
      WRITE( KW, 303) IY
      GO TO 100
C:    -------
 303  FORMAT( 2X, 24HWARN: ALL BETAS FOR LINE, I3, 13H SET TO ZERO.)
 73   CONTINUE
C:BUG      WRITE( KW, 203) IY
C:BUG      DO 771 IX= 1, NX1
C:BUG      WRITE( KW, 204) ( GG( IX, IJX), IJX= 1, NX2)
C:BUG771   WRITE( KW, 204) G2( IX)
C:ALT      IK= -9
C:ALT     CALL SOLV( NX2, 1, GG, MNX+ 2, G2, MNX+ 2, RR, MNX+ 2, KW, IK)
      CALL SOLV( NX1, 1, GG, MNX+ 2, G2, MNX+ 2, RR, MNX+ 2, KW, IK)
      IF ( IK.NE. 0) WRITE( KW, 601) IY
      IF ( IK.NE. 0) GO TO 85
      DO 50 IJX= 1, NX1
 50    BET( IY, IJX)= RR( IJX)
85    CONTINUE
C:ALT      GAM( IY, NX1)= RR( NX2)
       GAM( IY, NX1)= 0.
C:BUG      WRITE( KW, 204) GAM( IY, NX1), BET( IY, NX1)
C:BUG      WRITE( KW, 204) ( BET( IY, JX), JX= 1, NX)
 100  CONTINUE
C:BUG      WRITE( 6, 202) NSTD, ( BET( IY, NX1), IY= 1, NY)
C:BUG      STDER= 0.
C:BUG      DO 98 IY= 1, NY
C:BUG       YSTD= Y1( NSTD, IY)
C:BUG      RELER( IY)= 0.
C:BUG      IF ( YSTD.NE. 0.) RELER( IY)= ( YC( IY)- YSTD)/ YSTD
C:BUG98     STDER= STDER+ RELER( IY)** 2
C:BUG       STDER= SQRT( STDER/ FLOAT( NY- 1))
C:BUG      WRITE( 6, 203) NSTD, ( RELER( IY), IY= 1, NY), STDER
      IF ( KOP.EQ. 1) CALL ADJB1( NX, NY)
 99   CONTINUE
      RETURN
C:-------
C:BUG201   FORMAT( 2X, 2F9.5/ 2X, 8F9.5/ 2X, 8F9.5)
C:BUG202   FORMAT( 2X, I3, 8F7.2/ 4X, 8F7.2/ 4X, 8F7.2/ 4X, 8F7.2)
C:BUG203   FORMAT( 2X, I3, 8F7.3/ 4X, 8F7.3/ 4X, 8F7.3/ 4X, 8F7.3)
C:BUG204   FORMAT( 2X, 6E11.3)
601   FORMAT( 2X, 21H >>>>> BETAS FOR LINE, I3, 16H NOT CALCULATED.)
      END
C:****END     GAMBS     OMIT FROM NRLSIM
C:****BEGIN   XSF(
      FUNCTION XSF( IS, IX)
       Character*16 HIN
      DOUBLE PRECISION HSAMP, HTEST, HXS, HXU
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMX/ HXS( 51, 20), X1( 51, 20, 2)
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
C:----------
       XSF= X1( IS, IX, 1)
      IF ( IS.GT. NSAM) GO TO 99
       HTEST= HXU( IX)
      IF ( HTEST.EQ. HXS( IS, IX)) GO TO 99
       XSF= 0.
       IXS2= PS( IS, 1)
      IF ( IXS2.LT. 1) GO TO 99
      DO 1 IXS= 1, IXS2
      IF ( HTEST.EQ. HXS( IS, IXS)) GO TO 2
 1    CONTINUE
      GO TO 99
 2    IF ( X1( IS, IXS, 1).GE. 0.) XSF= X1( IS, IXS, 1)
 99   CONTINUE
      RETURN
      END
C:****END     XSF(
C:****BEGIN   SSTDS
      SUBROUTINE SSTDS( KV, XC, NX, NEL, YC, NY, SSTD, IS1, IS2, YMULT)
       Character*16 HIN
      DOUBLE PRECISION HSAMP
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
C:MOD  BEGIN                                OMIT FROM NRLEMP
      COMMON/YNORC/ YNOR( 51, 30)
C:MOD  END                                  OMIT FROM NRLEMP
      DIMENSION XC( NX), YC( NY), SSTD( IS2), YMULT( NY)
      DIMENSION VC( 30), VIS( 30), XD1( 20), XD2( 20), CC( 20)
      DIMENSION EC( 30), ES( 30)
      DATA ISNU/ 0/
C:----------
C:BUG      WRITE( 6, *) KV, NX, NY, IS1, IS2
      IF ( IS1.GT. 2) GO TO 35
      DO 34 IY= 1, NY
      SUM1= 0.
      SUM2= 0.
      IF ( KV.LT. 2) GO TO 33
C:MOD  BEGIN                                OMIT FROM NRLEMP
      DO 32 IS= 2, NS1
      YNORT= YNOR( IS, IY)
      IF ( YNORT.LE. 0.) GO TO 32
      SUM1= SUM1+ YNORT
      SUM2= SUM2+ 1.
   32 CONTINUE
C:MOD  END                                  OMIT FROM NRLEMP
   33 YMULT( IY)= 1.
      IF ( SUM2.GT. 0.) YMULT( IY)= SUM1/ SUM2
34    CONTINUE
   35 IF ( IS1.GT. IS2) GO TO 999
      IF ( KV.GE. 2) GO TO 3
       NC= NEL
      CALL XTOC( CC, NEL, XC, NX)
      DO 2 IC= 1, NC
      EC( IC)= 0.1
    2  VC( IC)= CC( IC)
      GO TO 5
C:    -------
3      NC= NY
      DO 4 IC= 1, NC
      EC( IC)= ABS( YE( JSR, IC))
    4  VC( IC)= YC( IC)
5     CONTINUE
      DO 22 IS= IS1, IS2
       SSTD( IS)= 0.
      IF ( PS( IS, 5).LE. 0.) GO TO 22
      IF ( KV.GE. 2) GO TO 6
      CALL XSAMP( IS+ 0, XD1, XD2, NX, 0)
      CALL XTOC( VIS, NEL, XD1, NX)
      DO 15 IC= 1, NC
   15  ES( IC)= 0.1
      GO TO 8
C:    -------
6     DO 7 IC= 1, NC
      ES( IC)= ABS( YE( IS, IC))
       VIS( IC)= Y1( IS, IC)
      IF ( YE( IS, IC).LE. 0.) VIS( IC)= VIS( IC)* YMULT( IC)
    7 CONTINUE
8     CONTINUE
      IF ( IS.GT. NS1) GO TO 24
      IF ( KV.GE. 2) GO TO 20
       KNZ= 0
      DO 9 IY= 1, NY
      IF ( YC( IY).LE. 0.) GO TO 9
      IF ( Y1( IS, IY).LE. 0.) GO TO 9
       KNZ= 1
 9    CONTINUE
      IF ( KNZ.EQ. 0) GO TO 22
 20    KEQ= 1
       KNZ= 0
      DO 23 IC= 1, NC
      IF ( VC( IC).LE. 0.) GO TO 23
      VISI= VIS( IC)
      IF ( VISI.LE. 0.) GO TO 23
       KNZ= 1
      IF ( ABS( VC( IC)- VISI).GT. 0.0001* ABS( VISI)) KEQ= 0
 23   CONTINUE
      IF ( KNZ.EQ. 0) GO TO 22
      IF ( KEQ.EQ. 0) GO TO 24
      IF ( IS.EQ. ISNU) GO TO 22
      WRITE( KW, 777) HSAMP( IS)
       ISNU= IS
      GO TO 22
C:-------
 777  FORMAT( 2X, 13H >>> STANDARD, 2X, A10, 10H NOT USED.)
 24    SUM= 0.
      IF ( IS.EQ. ISNU) ISNU= 0
      SSTD( IS)= DISTF( NC, VC, VIS, EC, ES)
 22   CONTINUE
C:BUG      WRITE( 6, *) IS1, IS2
C:BUG      WRITE( 6, *) ( SSTD( IS), IS= IS1, IS2)
      IF ( NS1.LT. 2) GO TO 999
      IF ( IS1.GT. 2) GO TO 999
      IF ( KOP.EQ. 1) GO TO 999
      IF ( KV.GT. 2) GO TO 999
C:MOD  BEGIN                                OMIT FROM NRLEMP
      DO 38 IY= 1, NY
       SUM= 0.
       SYADJ= 0.
       ISN= YN( IY)
      IF ( ISN.NE. 0) YMULT( IY)= YNOR( ISN, IY)
      IF ( ISN.NE. 0) GO TO 38
      DO 36 IS= 2, NS1
      IF ( SSTD( IS).LE. 0.) GO TO 36
      IF ( YE( IS, IY).LE. 0.) GO TO 36
      IF ( YNOR( IS, IY).EQ. 0.) GO TO 36
C:BUG      IF ( YNOR( IS, IY).LT. 0.) WRITE( 6,*) IS, IY
      IF ( YNOR( IS, IY).LT. 0.) GO TO 36
      RRTOT= 1.E-8+ YE( JSR, IY)** 2 + YE( IS, IY)** 2 + SSTD( IS)
      WTSTD= 1./( YNOR( IS, IY)** 2 * RRTOT)
       SUM= SUM+ WTSTD* YNOR( IS, IY)
       SYADJ= SYADJ+ WTSTD
36    CONTINUE
      IF ( SYADJ.NE. 0.) YMULT( IY)= SUM/ SYADJ
      IF ( YMULT( IY).EQ. 0.) YMULT( IY)= 1.
      IF ( SYADJ.EQ. 0.) YMULT( IY)= 1.
38    CONTINUE
      DO 48 IY= 1, NY
      IF ( YN( IY).NE. 0.) GO TO 48
       SUM= 0.
       SYADJ= 0.
C:ALT      VARIY=(( 1.E-4+ ABS( EC( IY)))* VC( IY))** 2
      DO 46 IS= 2, NS1
      IF ( SSTD( IS).LE. 0.) GO TO 46
C:X??      IF ( YE( IS, IY).LE. 0.) GO TO 46
      IF ( YNOR( IS, IY).EQ. 0.) GO TO 46
C:BUG      IF ( YNOR( IS, IY).LT. 0.) WRITE( 6,*) IS, IY
      IF ( YNOR( IS, IY).LT. 0.) GO TO 46
      SSISIY= SSTD( IS)
C:ALT      VAR= VARIY+( YE( IS, IY)* Y1( IS, IY))** 2
C:ALT      SSISIY= 0.5*( SSTD( IS)+( VC( IY)- Y1( IS, IY))** 2/ VAR)
      RRTOT= 1.E-8+ YE( JSR, IY)** 2 + YE( IS, IY)** 2 + SSISIY
      IF ( YE( IS, IY).GT. 0.) YPURE= YNOR( IS, IY)
      IF ( YE( IS, IY).LE. 0.) YPURE= YMULT( IY)* YNOR( IS, IY)
      WTSTD= 1./( YPURE** 2 * RRTOT)
       SUM= SUM+ WTSTD* YPURE
      SYADJ= SYADJ+ WTSTD
46    CONTINUE
      IF ( SYADJ.NE. 0.) YMULT( IY)= SUM/ SYADJ
      IF ( YMULT( IY).EQ. 0.) YMULT( IY)= 1.
      IF ( SYADJ.EQ. 0.) YMULT( IY)= 1.
48    CONTINUE
C:MOD  END                                  OMIT FROM NRLEMP
C:BUG      WRITE( 6, *) ( YMULT( IY), IY= 1, NY)
999   CONTINUE
      RETURN
C:----------
      END
C:****END     SSTDS
C:****BEGIN   COEFS     OMIT FROM NRLSIM
      SUBROUTINE COEFS( NX, NY)
       Character*16 HIN
      DOUBLE PRECISION HABB, HXU
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
      COMMON/GB/ GAM( 30, 21), BET( 30, 21), GG( 22, 22)
      COMMON/COMP2/ HXU( 20), DEN1( 20), TBAR1( 20), XU( 20)
      IF ( NX.LE. 0) GO TO 99
      IF ( NY.LE. 0) GO TO 99
      WRITE( KW, 201)
      WRITE( KW, 202) ( HXU( IX), IX= 1, NX)
      DO 8 IY= 1, NY
      IF ( NZY( IY).LE. 0) GO TO 8
      CALL ZABD( NZY( IY), HABB, 1)
       BETZ= BET( IY, NX+ 1)
      WRITE( KW, 204) HABB
      WRITE( KW, 205) ( GAM( IY, IX), IX= 1, NX)
      WRITE( KW, 206) ( BET( IY, IX), IX= 1, NX)
      WRITE( KW, 207) BETZ
 8    CONTINUE
      WRITE( KW, 203)
 99   RETURN
C:-------
 201  FORMAT(/ 2X, 41H FOR EACH LINE, THE EMPIRICAL EXPRESSION,
     1 / 2X, 47H AS AN EQUATION LINEAR IN THE AMOUNTS (W'S), IS
     1 // 2X, 43H  (G1-B1*XI)*W1 +(G2-B2*XI)*W2 +... = B0*XI
     1 /)
 202  FORMAT(/ 2X, 19X, 11HCOMPONENTS:
     1 / 2X, 5HLINES, 14X, 4( A8, 5X),/ ( 2X, 19X, 4( A8, 5X)))
 203  FORMAT( 2X, 1H )
 204  FORMAT(/ 2X, A2)
 205  FORMAT( 2X, 4HG'S:, 13X, 4E13.5,/ ( 2X, 17X, 4E13.5))
 206  FORMAT( 2X, 4HB'S:, 13X, 4E13.5,/ ( 2X, 17X, 4E13.5))
 207  FORMAT( 2X, 4HB0= , E13.5)
      END
C:****END     COEFS     OMIT FROM NRLSIM
C:****BEGIN   DISTF(
      FUNCTION DISTF( NC, VC, VS, EC, ES)
      DIMENSION VC( NC), VS( NC), EC( NC), ES( NC)
C:----------
      DISTF= -1.E10
      SS1= 0.
      SS2= 0.
      DO 4 IC= 1, NC
      IF ( VC( IC).LT. 0.) GO TO 4
      IF ( VS( IC).LT. 0.) GO TO 4
      IF ( ABS( VC( IC)- VS( IC)).LE. 0.0001* VS( IC)) GO TO 4
      VAR= ( VC( IC)* EC( IC))** 2+ ( VS( IC)* ES( IC))** 2
      IF ( VAR.LE. 0.) GO TO 4
      WT= 1./ VAR
      SS1= SS1+ WT*( VC( IC)- VS( IC))** 2
      SS2= SS2+ 1.
    4 CONTINUE
      IF ( SS2.LE. 0.) GO TO 40
      DISTF= 1.E-4* SS1/ SS2
   40 CONTINUE
C:BUG      WRITE( 6, *) SS1, SS2, DISTF
      RETURN
C:----------
      END
C:****END     DISTF(
C:****BEGIN   SIM                           OMIT FROM NRLEMP
      SUBROUTINE SIM( XU, NX, YSIM, NY, CC, NEL)
       Character*16 HIN
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/GRAIN/ TBAR( 20), DEN( 20), VVOID, TVOID
      DIMENSION YSIM( NY), XU( NX), CC( NEL)
C:----------
      IF ( KPREP.EQ. 0) GO TO 7
C:BUG      WRITE( 6, *) NEL, NY, KOP
      CALL  PREP( NEL, NY)
      CALL SIMP( NZEL, NEL, NY)
      CALL SIMR( NZEL, NEL, NY)
 7    IF ( KIND.LT. 3) GO TO 8
      DO 19 IX= 1, NX
      IF ( DEN( IX).GT. 0.) GO TO 19
      IF ( TBAR( IX).EQ. 0.) GO TO 19
      IF ( XU( IX).EQ. 0.) GO TO 19
      WRITE( KW, 205) IX
 19   CONTINUE
 205  FORMAT( 2X, 41H WARN: NON-POSITIVE DENSITY FOR COMPONENT, I3,
     1 23H-- INPUT IT VIA DEFINE.)
 8    CONTINUE
      IF ( KIND.LE. 2) CALL SIM2( CC, NEL, YSIM, NY)
      IF ( KIND.EQ. 3) CALL SIM4( CC, NEL, YSIM, NY, XU, NX)
      IF ( KIND.EQ. 4) CALL SIM6( CC, NEL, YSIM, NY, XU, NX)
      RETURN
C:-------
      END
C:****END     SIM                           OMIT FROM NRLEMP
C:****BEGIN   YBAR      OMIT FROM NRLSIM
      SUBROUTINE YBAR( XU, NX, YC, NY)
      COMMON/GB/ GAM( 30, 21), BET( 30, 21), GG( 22, 22)
      DIMENSION XU( NX), YC( NY)
      DO 2 IY= 1, NY
       SUM1= GAM( IY, NX+ 1)
       SUM2= BET( IY, NX+ 1)
      DO 1 IX= 1, NX
       SUM1= SUM1+ XU( IX)* GAM( IY, IX)
 1     SUM2= SUM2+ XU( IX)* BET( IY, IX)
 2     YC( IY)= SUM1/ SUM2
      RETURN
C:-------
      END
C:****END     YBAR      OMIT FROM NRLSIM
C:****BEGIN   SIM2                          OMIT FROM NRLEMP
      SUBROUTINE SIM2( CC, NEL, ROC, NY)
      COMMON/SPEC2/ NW2, W2( 80), SP2( 300), JSP2( 30), RMESH
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      COMMON/PARAM/ NOL, JZL( 50), L6( 50), WLL( 50), JWL( 50),
     1 UC( 20, 50), BC( 20, 80)
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
      COMMON/CSCS/ CSC1( 30), CSC2( 30)
      COMMON/LMC/ PURE( 30), ROMZ( 30), YY( 30)
      DIMENSION ROC( NY), CC( NEL)
      DIMENSION UM( 50), BM( 80), CL( 50), UWJ( 50), FLL( 50)
C:DIM  UM( MNOL), BM( MNIN), CL( MNOL), UWJ( MNOL), FLL( MNOL)
      DO 2 IL= 1, NOL
 2     UM( IL)= DOTF( CC, UC( 1, IL), NEL)
      DO 4 IW= 1, NW2
 4     BM( IW)= DOTF( CC, BC( 1, IW), NEL)
      DO 12 IY= 1, NY
      ROC( IY)= 0.
       IL= JLM( IY)
      IF ( IL.LE. 0) GO TO 12
      IF ( JWL( IL).LT. 1) GO TO 12
       L6IL= L6( IL)
       IZ= JZL( IL)
       NZIZ= NZEL( IZ)
      IF ( CC( IZ).GT. 0.) GO TO 5
 5    CONTINUE
       X= UM( IL)* CSC2( IY)
      DO 7 KL= 1, NOL
       FLL( KL)= FLF( NZIZ, L6( IL), WLL( KL), KFL)
      IF ( FLL( KL).LE. 0.) GO TO 7
       UWJ( KL)= UC( IZ, KL)
       CL( KL)= 0.
      IF ( UM( KL).EQ. 0.) GO TO 7
       CL( KL)= 1.
      IF ( X.NE. 0.) CL( KL)= ALOG( 1.+ X/ UM( KL))/ X
 7    CONTINUE
       FAS= 0.
       ISPY= JSPY( IY)
       IW2= JWL( IL)
       IWZ= JSP2( ISPY)
C:BUG      WRITE( 6, *) IWZ, IW2
C:BUG      WRITE( 6, *) W2( 1), SP2( IWZ+ 1), W2( IW2), SP2( IWZ+ IW2)
      DO 10 IW= 1, IW2
       W2IW= W2( IW)
       FLN= FLF( NZIZ, L6IL, W2IW, KFL)
      IF ( FLN.LE. 0.) GO TO 10
       BMN= BM( IW)* CSC1( IY)
       BMNX= BMN+ X
      IF ( BMNX.EQ. 0.) GO TO 10
       S= 0.
      IF ( THICK.LE. 0.) GO TO 13
      DO 9 KL= 1, NOL
       KZ= JZL( KL)
       NZKZ= NZEL( KZ)
      IF ( CC( KZ).EQ. 0.) GO TO 9
      IF ( FLL( KL).LE. 0.) GO TO 9
      IF ( IW.GT. JWL( KL)) GO TO 9
      IF ( UM( KL).EQ. 0.) GO TO 9
      IF ( BMN.EQ. 0.) GO TO 9
       SJ= UWJ( KL)*( ALOG( 1.+ BMN/ UM( KL))/ BMN+ CL( KL))
       SJ= SJ* FLF( NZKZ, L6( KL), W2IW, KFL)
       SJ= SJ* FLL( KL)
      IF ( KIND.EQ. 2)
     1 SJ= SJ* EXP1F(( BMN+ 2.* UM( KL))* ABS( THICK))
       S= S+ CC( KZ)* SJ* BC( KZ, IW)
 9    CONTINUE
 13    ADD= SP2( IWZ+ IW)*( BC( IZ, IW)* FLN+ 0.5* S)/ BMNX
C:
      IF ( KIND.EQ. 2) ADD= ADD* EXP1F( BMNX* ABS( THICK))
       FAS= FAS+ ADD
 10   CONTINUE
C:BUG      WRITE( 6, *) IY, FAS
       ROC( IY)= 0.0795775* AREA* FAS/ PURE( IY)
 11   CONTINUE
 12   CONTINUE
      RETURN
C:-------
      END
C:****END     SIM2                          OMIT FROM NRLEMP
C:****BEGIN   ADJB1     OMIT FROM NRLSIM
      SUBROUTINE ADJB1( NX, NY)
       Character*16 HIN
      DOUBLE PRECISION HSAMP
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/GB/ GAM( 30, 21), BET( 30, 21), GG( 22, 22)
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/MXS/ MNW, MNIN, MNX, MNY, MNEL, MNOL, MNS
      COMMON/STD/ NS1, NSTD, BZ, XUS, KADJY, YNOR1( 51)
      COMMON/SAM/ HSAMP( 51), NSAM, PS( 51, 7)
      COMMON/SAMY/ Y1( 51, 30), YE( 51, 30), YN( 30), YPAR( 30, 7)
      DIMENSION VC( 30), VS( 30), EC( 30), ES( 30)
C:DIM  VC( MNY), VS( MNY), EC( MNY), ES( MNY)
      DIMENSION XC( 20), YC( 30), SY1( 30), SY2( 30), EEC( 30)
C:DIM  XC( MNX), YC( MNY)
C:----------
      NX1= NX+ 1
      DO 10 IY= 1, NY
      VC( IY)= Y1( JSR, IY)
      EC( IY)= ABS( YE( JSR, IY))
      EEC( IY)= EC( IY)** 2
      SY1( IY)= 0.
      SY2( IY)= 0.
   10 CONTINUE
      DO 70 IS= 2, NS1
      SS= 0.
      IF ( PS( IS, 5).LE. 0.) GO TO 70
      DO 12 IY= 1, NY
      VS( IY)= Y1( IS, IY)
      ES( IY)= ABS( YE( IS, IY))
   12 CONTINUE
      SS= DISTF( NY, VC, VS, EC, ES)
      IF ( SS.LE. 0.) GO TO 70
      DO 16 IX= 1, NX
   16 XC( IX)= XSF( IS+ 0, IX+ 0)
      CALL YBAR( XC, NX, YC, NY)
      DO 60 IY= 1, NY
      IF ( VC( IY).LE. 0.) GO TO 60
      IF ( VS( IY).LE. 0.) GO TO 60
      IF ( YC( IY).LE. 0.) GO TO 60
      YP= VS( IY)/ YC( IY)
C:ALT      VAR= EEC( IY)* VC( IY)** 2+( ES( IY)* VS( IY))** 2
C:ALT      SS= 0.5*( SS+( VC( IY)- VS( IY))** 2/ VAR)
      WW= YP** 2 *( EEC( IY)+ ES( IY)** 2+ SS)
      WW= 1./ WW
      SY1( IY)= SY1( IY)+ WW* YP
      SY2( IY)= SY2( IY)+ WW
   60 CONTINUE
   70 CONTINUE
      DO 80 IY= 1, NY
      IF ( VC( IY).LE. 0.) GO TO 80
      IF ( SY1( IY)* SY2( IY).GT. 0.) GO TO 72
      WRITE( KW, 601) IY
      GO TO 80
C:    -------
   72 CONST= SY2( IY)/ SY1( IY)
C:BUG
      SY1( IY)= CONST
      DO 76 IX= 1, NX1
   76 BET( IY, IX)= CONST* BET( IY, IX)
   80 CONTINUE
C:BUG      WRITE( 6, *) NY
C:BUG      WRITE( 6, *) ( SY1( IY), IY= 1, NY)
      RETURN
C:-------
  601 FORMAT( 2X, 27HERROR: NO STANDARD FOR LINE, I3)
      END
C:****END     ADJB1     OMIT FROM NRLSIM
C:****BEGIN   SIMP                          OMIT FROM NRLEMP
      SUBROUTINE SIMP( NZEL, NEL, NY)
      COMMON/SPEC2/ NW2, W2( 80), SP2( 300), JSP2( 30), RMESH
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
      COMMON/CSCS/ CSC1( 30), CSC2( 30)
      COMMON/LMC/ PURE( 30), ROMZ( 30), YY( 30)
      COMMON/PARAM/ NOL, JZL( 50), L6( 50), WLL( 50), JWL( 50),
     1 UC( 20, 50), BC( 20, 80)
      DIMENSION NZEL( NEL)
      DIMENSION CL( 50), UWJ( 50), FLL( 50)
C:DIM  CL( MNOL), UWJ( MNOL), FLL( MNOL)
      DO 12 IY= 1, NY
       PURE( IY)= 0.
       IL= JLM( IY)
      IF ( IL.LE. 0) GO TO 11
      IF ( JWL( IL).LE. 0) GO TO 11
       L6IL= L6( IL)
       IZ= JZL( IL)
       NZIZ= NZEL( IZ)
       X= UC( IZ, IL)* CSC2( IY)
      DO 7 KL= 1, NOL
       FLL( KL)= FLF( NZIZ, L6( IL), WLL( KL), KFL)
      IF ( FLL( KL).LE. 0.) GO TO 7
       UWJ( KL)= UC( IZ, KL)
       CL( KL)= 0.
      IF ( UC( IZ, KL).EQ. 0.) GO TO 7
       CL( KL)= 1.
      IF ( X.NE. 0.) CL( KL)= ALOG( 1.+ X/ UC( IZ, KL))/ X
 7    CONTINUE
       FAS= 0.
       ISPY= JSPY( IY)
       IW2= JWL( IL)
       IWZ= JSP2( ISPY)
      DO 10 IW= 1, IW2
       W2IW= W2( IW)
       FLN= FLF( NZIZ, L6IL, W2IW, KFL)
      IF ( FLN.LE. 0.) GO TO 10
       BMN= BC( IZ, IW)* CSC1( IY)
       BMNX= BMN+ X
      IF ( BMNX.EQ. 0.) GO TO 10
       S= 0.
      DO 9 KL= 1, NOL
       KZ= JZL( KL)
       NZKZ= NZEL( KZ)
      IF ( KZ.NE. IZ) GO TO 9
      IF ( FLL( KL).LE. 0.) GO TO 9
      IF ( IW.GT. JWL( KL)) GO TO 9
      IF ( UC( IZ, KL).EQ. 0.) GO TO 9
      IF ( BMN.EQ. 0.) GO TO 9
       SJ= UWJ( KL)*( ALOG( 1.+ BMN/ UC( IZ, KL))/ BMN+ CL( KL))
       SJ= SJ* FLF( NZKZ, L6( KL), W2IW, KFL)
       SJ= SJ* FLL( KL)
       S= S+ SJ* BC( KZ, IW)
 9    CONTINUE
       ADD= SP2( IWZ+ IW)*( BC( IZ, IW)* FLN+ 0.5* S)/ BMNX
C:
       FAS= FAS+ ADD
 10   CONTINUE
C:BUG      WRITE( 6, *) IY, FAS
       PURE( IY)= 0.0795775* FAS
 11   IF ( PURE( IY).LE. 0.) PURE( IY)= 1.E-34
 12   CONTINUE
      RETURN
C:-------
      END
C:****END     SIMP                          OMIT FROM NRLEMP
C:****BEGIN   EXP1F(                        OMIT FROM NRLEMP
      FUNCTION EXP1F( X)
      IF ( ABS( X).LT. 0.01) GO TO 1
       EXP1F= 1.0- EXP2F( -23., - X)
      RETURN
C:-------
 1     EXP1F= X*( 6.- X*( 3.- X))/ 6.
C:DOC  REL. ERR. LESS THAN .00000005 FOR / X/ < .01
      RETURN
C:-------
      END
C:****END     EXP1F(                        OMIT FROM NRLEMP
C:****BEGIN   SIM4                          OMIT FROM NRLEMP
      SUBROUTINE SIM4( CC, NEL, ROM, NY, XU, NX)
      COMMON/SPEC2/ NW2, W2( 80), SP2( 300), JSP2( 30), RMESH
      COMMON/PARAM/ NOL, JZL( 50), L6( 50), WLL( 50), JWL( 50),
     1 UC( 20, 50), BC( 20, 80)
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
      COMMON/LMC/ PURE( 30), ROMZ( 30), YY( 30)
      COMMON/GRAIN/ TBAR( 20), DEN( 20), VVOID, TVOID
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      DIMENSION XU( NX)
      DIMENSION ROM( NY), CC( NEL)
       XUT= 0.
      DO 1 IX= 1, NX
 1     XUT= XUT+ XU( IX)
       DELXU= 1.E-10* XUT
      DO 12 IY= 1, NY
       ROM( IY)= 0.
       IL= JLM( IY)
      IF ( IL.LE. 0) GO TO 12
      IF ( JWL( IL).LT. 1) GO TO 12
       IZ= JZL( IL)
       NZIZ= NZEL( IZ)
C:ALT      IF ( CC( IZ).LE. 0.) GO TO 12
       FAST= 0.
       CONS= 0.
      DO 20 IX= 1, NX
       FAS= 0.
       DENT= DEN( IX)* TBAR( IX)
       ISPY= JSPY( IY)
       IW2= JWL( IL)
       IWZ= JSP2( ISPY)
      DO 10 IW= 1, IW2
       W2IW= W2( IW)
       FLN= FLF( NZIZ, L6( IL), W2IW, KFL)
       FAS= FAS+ SP2( IWZ+ IW)* BC( IZ, IW)* FLN*
     1 FHETF( DOTF( PELC( 1, IX), BC( 1, IW), NEL)* DENT)
 10   CONTINUE
       CON= XU( IX)* PELC( IZ, IX)
      IF ( CC( IZ).LE. 0.) CON= DELXU* PELC( IZ, IX)
       CONS= CONS+ CON
 20    FAST= FAST+ FAS* CON* FHETF( DENT
     1 * DOTF( PELC( 1, IX), UC( 1, IL), NEL))
      IF ( CONS.GT. 0.)
     1 ROM( IY)= 0.0795775* FAST/ CONS
 12   CONTINUE
      RETURN
C:-------
      END
C:****END     SIM4                          OMIT FROM NRLEMP
C:****BEGIN   SIMR                          OMIT FROM NRLEMP
      SUBROUTINE SIMR( NZEL, NEL, NY)
      COMMON/SPEC2/ NW2, W2( 80), SP2( 300), JSP2( 30), RMESH
      COMMON/GRAIN/ TBAR( 20), DEN( 20), VVOID, TVOID
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
      COMMON/LMC/ PURE( 30), ROMZ( 30), YY( 30)
      COMMON/PARAM/ NOL, JZL( 50), L6( 50), WLL( 50), JWL( 50),
     1 UC( 20, 50), BC( 20, 80)
      DIMENSION NZEL( NEL)
      DO 15 IY= 1, NY
       ROMZ( IY)= 0.
       IL= JLM( IY)
      IF ( IL.LE. 0) GO TO 16
      IF ( JWL( IL).LT. 1) GO TO 16
       IZ= JZL( IL)
       NZIZ= NZEL( IZ)
       L6I= L6( IL)
       S= 0.
       ISPY= JSPY( IY)
       IW2= JWL( IL)
       IWZ= JSP2( ISPY)
      DO 14 IW= 1, IW2
 14    S= S+ SP2( IWZ+ IW)* BC( IZ, IW)*
     1 FLF( NZIZ, L6I, W2( IW), KFL)
      IF ( S.LE. 0.) S= -1.
       ROMZ( IY)= 0.0795775* S
 16   IF ( ROMZ( IY).LE. 0.) ROMZ( IY)= 1.E-34
 15   CONTINUE
      RETURN
C:-------
      END
C:****END     SIMR                          OMIT FROM NRLEMP
C:****BEGIN   SIM6                          OMIT FROM NRLEMP
      SUBROUTINE SIM6( CC, NEL, ROC, NY, XU, NX)
      COMMON/SPEC2/ NW2, W2( 80), SP2( 300), JSP2( 30), RMESH
      COMMON/PARAM/ NOL, JZL( 50), L6( 50), WLL( 50), JWL( 50),
     1 UC( 20, 50), BC( 20, 80)
      COMMON/KRUN/ KPCT, KPREP, KADJB, KOP, JSR, KIND, THICK, AREA
      COMMON/LMEAS/ NZY( 30), HLY( 30), JSPY( 30), JLM( 30)
      COMMON/CSCS/ CSC1( 30), CSC2( 30)
      COMMON/LMC/ PURE( 30), ROMZ( 30), YY( 30)
      COMMON/GRAIN/ TBAR( 20), DEN( 20), VVOID, TVOID
      COMMON/COMPS/ NZEL( 20), PELC( 20, 20)
      DIMENSION XU( NX)
      DIMENSION ROC( NY), CC( NEL)
      DIMENSION UM( 50), BM( 80), CL( 50), FLL( 50)
C:DIM  UM( MNOL), BM( MNIN), CL( MNOL), FLL( MNOL)
      DIMENSION ABIL( 20), ABIW( 20), FLIW( 20), FLIL2( 20)
C:DIM  ABIL( MNX), ABIW( MNX), FLIW( MNX), FLIL2( MNX)
      DIMENSION BMX( 20), RFL( 20), RFW( 20), VU( 20), VUE( 20)
C:DIM  BMX( MNX), RFL( MNX), RFW( MNX), VU( MNX), VUE( MNX)
      DIMENSION UMX( 20), ABIL2( 20)
C:DIM  UMX( MNX), ABIL2( MNX)
C:----------
       NX1= NX+ 1
C:
C:    VOLUME FRACTIONS OF THE COMPONENTS; OVERALL DENSITY
      DO 22 IX= 1, NX
       VU( IX)= 0.
      IF ( DEN( IX).GT. 0.) VU( IX)= XU( IX)/ DEN( IX)
   22 CONTINUE
      CALL NORM( VU, NX, 1.- VVOID, VMULT)
       VU( NX1)= VVOID
       RHO= DOTF( VU, DEN, NX)
C:
C:    EFFECTIVE M.A.C. FOR EACH LINE, UM( IL)
      DO 2 IL= 1, NOL
       IL2= IL
       S= 0.
       VUTOT= VVOID
      DO 1 IX= 1, NX
       ALAC= DEN( IX)* DOTF( PELC( 1, IX), UC( 1, IL2), NEL)
       VUMOD= VU( IX)* FHETF( ALAC* TBAR( IX))
       VUTOT= VUTOT+ VUMOD
 1     S= S+ VUMOD* ALAC
       CONST= VUTOT* RHO
       UM( IL)= 1.E+10
      IF ( CONST.GT. 0.) UM( IL)= S/ CONST
 2    CONTINUE
C:    -------
C:
C:    OUTERMOST LOOP, OVER THE MEASURED LINES, IY
      DO 12 IY= 1, NY
       ROC( IY)= 0.
       IL= JLM( IY)
      IF ( IL.LE. 0) GO TO 12
      IF ( JWL( IL).LT. 1) GO TO 12
       IZ= JZL( IL)
       NZIZ= NZEL( IZ)
       X= UM( IL)* CSC2( IY)
C:
C:    EFFICIENCY OF FLUOR. BY EACH LINE GENERATED, FLL( KL)
      DO 7 KL= 1, NOL
       FLL( KL)= FLF( NZIZ, L6( IL), WLL( KL), KFL)
      IF ( FLL( KL).LE. 0.) GO TO 7
       CL( KL)= 0.
      IF ( UM( KL).EQ. 0.) GO TO 7
       CL( KL)= 1.
      IF ( X.NE. 0.) CL( KL)= ALOG( 1.+ X/ UM( KL))/ X
 7    CONTINUE
      DO 30 IX= 1, NX
       FLIW( IX)= 0.
 30    FLIL2( IX)= 0.
C:
C:    EFFECTIVE VOLUME FRACTIONS, VUE( IX), FOR MEASURED LINE
      DO 31 IX= 1, NX
       AMAC= DOTF( PELC( 1, IX), UC( 1, IL), NEL)
       UMX( IX)= AMAC
       ALAC= AMAC* DEN( IX)
       RFL( IX)= FHETF( ALAC* TBAR( IX))
 31    VUE( IX)= VU( IX)* RFL( IX)
       VUE( NX1)= VVOID
      CALL NORM( VUE, NX1, 1., VMULT)
C:
C:    FRACTION OF MEAS. X-RAYS ABSORBED IN EACH PHASE, ABIL( IX)
       ALAC= 0.
      DO 32 IX= 1, NX
       ABIL( IX)= VUE( IX)* UMX( IX)* DEN( IX)
 32    ALAC= ALAC+ ABIL( IX)
      CALL NORM( ABIL, NX, 1., AMULT)
      DO 33 IX= 1, NX
       RFL( IX)= RFL( IX)/ FHETF( UM( IL)* DEN( IX)* TBAR( IX))
 33   CONTINUE
C:
       ISPY= JSPY( IY)
       IW2= JWL( IL)
       IWZ= JSP2( ISPY)
C:
C:    SECOND-LEVEL LOOP, OVER INCIDENT WAVELENGTHS, IW
      DO 10 IW= 1, IW2
       W2IW= W2( IW)
C:
C:    EFFECTIVE VOLUME FRACTIONS, VUE( IX), FOR INCIDENT X-RAYS
      DO 41 IX= 1, NX
       AMAC= DOTF( PELC( 1, IX), BC( 1, IW), NEL)
       BMX( IX)= AMAC
       ALAC= AMAC* DEN( IX)
       RFW( IX)= FHETF( ALAC* TBAR( IX))
 41    VUE( IX)= VU( IX)* RFW( IX)
       VUE( NX1)= VVOID
      CALL NORM( VUE, NX1, 1., VMULT)
C:
C:    EFFECTIVE M.A.C., BM( IW), FOR INCIDENT WAVELENGTH, AND
C:    FRACTION OF INC. X-RAYS ABSORBED IN EACH PHASE, ABIW( IX)
       ALAC= 0.
      DO 42 IX= 1, NX
       ABIW( IX)= VUE( IX)* BMX( IX)* DEN( IX)
 42    ALAC= ALAC+ ABIW( IX)
       BM( IW)= 0.
      IF ( RHO.GT. 0.) BM( IW)= ALAC/ RHO
      CALL NORM( ABIW, NX, 1., AMULT)
      DO 43 IX= 1, NX
       RFW( IX)= RFW( IX)/ FHETF( BM( IW)* DEN( IX)* TBAR( IX))
 43   CONTINUE
       BMN= BM( IW)* CSC1( IY)
       BMNX= BMN+ X
      IF ( BMNX.EQ. 0.) GO TO 10
       EXPIW= EXP1F( BMNX* ABS( THICK))
C:
C:    THIRD-LEVEL LOOP, OVER THE DIFFERENT PHASES, IX
      DO 20 IX= 1, NX
      IF ( PELC( IZ, IX).LE. 0.) GO TO 20
C:X      DENT= DEN( IX)* TBAR( IX)
C:
C:    FOURTH-LEVEL LOOP, OVER ALL LINES GENERATED, KL
C:     (FOR INDIRECT FLUORESCENCE)
      IF ( THICK.LE. 0.) GO TO 13
      DO 9 KL= 1, NOL
      DO 51 IX2= 1, NX
       ALAC= DEN( IX2)* DOTF( PELC( 1, IX2), UC( 1, KL), NEL)
 51    ABIL2( IX2)= VU( IX2)* ALAC
      CALL NORM( ABIL2, NX, 1., AMULT)
       KZ= JZL( KL)
       NZKZ= NZEL( KZ)
      IF ( CC( KZ).EQ. 0.) GO TO 9
      IF ( FLL( KL).LE. 0.) GO TO 9
      IF ( IW.GT. JWL( KL)) GO TO 9
      IF ( UM( KL).EQ. 0.) GO TO 9
      IF ( BMN.EQ. 0.) GO TO 9
       CONST= DOTF( PELC( 1, IX), UC( 1, KL), NEL)
       SJ= 0.
      IF ( CONST.GT. 0.) SJ= ABIL2( IX)
     1 * UC( IZ, KL)/ CONST
     1 * UM( KL)
       SJ= SJ*( ALOG( 1.+ BMN/ UM( KL))/ BMN+ CL( KL))
       SJ= SJ* FLF( NZKZ, L6( KL), W2IW, KFL)
       SJ= SJ* FLL( KL)
       SJ= SJ* EXP1F(( BMN+ 2.* UM( KL))* ABS( THICK))
      IF ( BMNX.GT. 0.) FLIL2( IX)= FLIL2( IX)+
     1  0.5* SP2( IWZ+ IW)* CC( KZ)* BC( KZ, IW)* SJ/ BMNX
     1 * EXPIW
C:ALT     1 * RFW( IX)
 9    CONTINUE
C:
 13    FLN= FLF( NZIZ, L6( IL), W2IW, KFL)
      IF ( BMX( IX).GT. 0.) FLIW( IX)= FLIW( IX)+
     1  SP2( IWZ+ IW)* BC( IZ, IW)/ BMX( IX)* FLN/ BMNX
     1 * ABIW( IX)* BM( IW)
     1 * EXPIW
C:ALT     1 * RFW( IX)
 20   CONTINUE
C:
 10   CONTINUE
C:
       SUM1= 0.
       SUM2= 0.
      DO 52 IX= 1, NX
       SUM1= SUM1+
     1  PELC( IZ, IX)* FLIW( IX)
     1 * RFL( IX)
       SUM2= SUM2+
     1  PELC( IZ, IX)* FLIL2( IX)
     1 * RFL( IX)
 52   CONTINUE
      IF ( CC( IZ)* PURE( IY).LE. 0.) GO TO 53
       SUM1= 0.0795775* AREA* SUM1/ CC( IZ)/ PURE( IY)
       SUM2= 0.0795775* AREA* SUM2/ CC( IZ)/ PURE( IY)
       ROC( IY)= SUM1+ SUM2
 53   CONTINUE
C:BUG      WRITE( 5, *) IY, SUM1, SUM2, ROC( IY)
 12   CONTINUE
      RETURN
C:-------
      END
C:****END     SIM6                          OMIT FROM NRLEMP
C:****BEGIN   DEFD
      SUBROUTINE DEFD( HT, R, NEX, NZ, CE, LDEX, KU1)
       Character*16 HIN
      DOUBLE PRECISION HT, HXX, HE, HEND, HXX2, HBLNK
      COMMON/KIO/ KR, KS, KW, KEND, IH, HIN( 200), KOUT
      COMMON/HFS/ HFE( 3), HFA( 2)
      DIMENSION NZ( LDEX), CE( LDEX)
C:MOD  BEGIN     ONLY IF DATA FILE XRDATC IS USED
      DIMENSION HXX( 500), HE( 20)
C:DIM  HE( NO. OF ELEMENTS PER COMPONENT)
C:DIM  HXX( NO. OF FILED COMPONENTS)
C:MOD  END       ONLY IF DATA FILE XRDATC IS USED
      DATA HATOM/ 1HA/, HMASS/ 1HM/, HEND/ 6HEND   /
      DATA HBLNK/ 6H      /
C:----------
      CALL IN( -1, -2, 2, KEND, HIN)
      CALL ZABD( NZI, HT, -1)
      IF ( NZI.EQ. 0) GO TO 3
       NEX= 1
       NZ( 1)= NZI
       CE( 1)= 1.0
      GO TO 99
C:-------
 3    CONTINUE
C:MOD  BEGIN     ONLY IF DATA FILE XRDATC IS USED
      IF ( KR.EQ. KU1) GO TO 13
      CALL FILIO( KU1, 3, 1, 1, 1)
       IXX= 1
 4    CALL IN( KU1, 1, 2, KEND, HIN)
       IH= 1
C:SCR      READ( KS, 101) HXX( IXX), HXX2
      DECODE( 16, 101, HIN( IH)) HXX( IXX), HXX2
       IH= IH+ 4
      IF ( HXX( IXX).EQ. HBLNK) HXX( IXX)= HXX2
      CALL IN( KU1, 0, 2, KEND, HIN)
      IF ( HXX( IXX).EQ. HEND) GO TO 6
      IF ( HXX( IXX).EQ. HT) GO TO 9
       IXX= IXX+ 1
       NXX= IXX
      GO TO 4
C:-------
 6    REWIND KU1
 7    DO 8 IXX= 1, NXX
      IF ( HT.EQ. HXX( IXX)) GO TO 9
 8    CONTINUE
      GO TO 17
C:-------
 9    REWIND KU1
       IXX2= IXX- 1
      IF ( IXX2.LT. 1) GO TO 13
      DO 11 IXX= 1, IXX2
 11   READ( KU1, 101) HN
 13   CONTINUE
      CALL IN( KU1, 4, 0, KEND, HIN)
       IH= 5
C:SCR      READ( KS, 701) R, HAM, XXX
      DECODE( 16, HFE, HIN( IH)) R
       IH= IH+ 4
      DECODE( 16, 703, HIN( IH)) HAM
       IH= IH+ 4
      DECODE( 16, HFE, HIN( IH)) XXX
       IH= IH+ 4
C:BUG      WRITE( KW, 206) HAM
       NEX= XXX
 701  FORMAT(/ E16.0/ A1/ E16.0)
      IF ( NEX.GT. LDEX) GO TO 15
      CALL IN( KU1, 2* NEX, 0, KEND, HIN)
       IH= 1
C:SCR      READ( KS, 702) ( HE( IEX), CE( IEX), IEX= 1, NEX)
      DO 31 IEX= 1, NEX
      DECODE( 16, HFA, HIN( IH)) HE( IEX)
       IH= IH+ 4
      DECODE( 16, HFE, HIN( IH)) CE( IEX)
 31    IH= IH+ 4
 702  FORMAT( A8/ E16.0)
 703  FORMAT( A1, 15X, E16.0)
      DO 14 IEX= 1, NEX
      CALL ZABD( NZ( IEX), HE( IEX), -1)
      IF ( NZ( IEX).LE. 0) GO TO 17
 14   CONTINUE
      GO TO 19
C:-------
 15   WRITE( KW, 205) HT, LDEX
 205  FORMAT( 2X, A10, 15H HAS MORE THAN , I2, 11H ELEMENTS. )
      CALL ERROR( 0)
 17   CONTINUE
C:MOD  END       ONLY IF DATA FILE XRDATC IS USED
       KU6= KUF( 6)
      WRITE( KU6, 211) HT
 211  FORMAT( 2X, 26HWARN: YOU NEED TO  DEFINE , A10)
       NEX= 0
C:MOD  BEGIN     ONLY IF DATA FILE XRDATC IS USED
      GO TO 99
C:-------
 19    S= 0.
      DO 22 IEX= 1, NEX
      IF ( HAM.EQ. HATOM) CE( IEX)= CE( IEX)* ATWTF( NZ( IEX))
 22    S= S+ CE( IEX)
      IF ( S.NE. 0.) S= 1./ S
      DO 23 IEX= 1, NEX
 23    CE( IEX)= S* CE( IEX)
C:MOD  END       ONLY IF DATA FILE XRDATC IS USED
 99   CONTINUE
C:MOD  BEGIN     ONLY IF DATA FILE XRDATC IS USED
      IF ( KR.NE. KU1) CALL FILIO( KU1, 3, 1, 1, 2)
C:MOD  END       ONLY IF DATA FILE XRDATC IS USED
      CALL IN( -1, -2, 2, KEND, HIN)
      RETURN
C:-------
 101  FORMAT( A8, A8)
 202  FORMAT( 2X, A2, 17H NOT AN ELEMENT. )
 204  FORMAT( 2X, 9H LIST THE, I3, 14H PROPORTIONS :)
 206  FORMAT( 2X, A4)
      END
C:****END     DEFD
C:****BEGIN   ATWTF(
      FUNCTION ATWTF( I)
      DIMENSION ATWTD( 110)
C:DIM  ATWTD( 110)
      DATA ATWTD
     1 / 1.008, 04.003, 06.939, 09.012, 10.811, 12.011,
     1 14.007, 15.999, 18.998, 20.183, 22.997, 24.320,
     1 26.980, 28.070, 30.975, 32.060, 35.450, 39.950,
     1 39.100, 40.080, 44.960, 47.900, 50.940, 51.996,
     1 54.938, 55.850, 58.933, 58.710, 63.540, 65.370,
     1 69.720, 72.590, 74.920, 78.960, 79.910, 83.800,
     1 85.480, 87.620, 88.905, 91.220, 92.906, 95.940,
     1 99.000, 101.07, 102.90, 106.40, 107.87, 112.41,
     1 114.82, 118.69, 121.76, 127.60, 126.91, 131.30,
     1 132.91, 137.36, 138.92, 140.13, 140.92, 144.27,
     1 147.00, 150.35, 152.00, 157.26, 158.93, 162.51,
     1 164.94, 167.27, 168.94, 173.04, 174.99, 178.50,
     1 180.95, 183.83, 186.20, 190.20, 192.20, 195.09,
     1 196.967, 200.61, 204.39, 207.19, 209.0, 210.00,
     1 210.00, 222.00, 223.00, 226.00, 227.00, 232.04,
     1 231.00, 238.03, 237.00, 244.00, 243.00, 247.00,
     1 247.00, 251.00, 254.00, 253.00, 000.00, 000.00,
     1 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/
      IF ( I.LE. 0) GO TO 99
      IF ( I.GT. 110) GO TO 99
       ATWTF= ATWTD( I)
      RETURN
C:-------
 99    ATWTF= 0.
      RETURN
C:-------
      END
C:****END     ATWTF(
C:****BEGIN   ZABD
      SUBROUTINE ZABD( IZ, HABB, K)
       Character*16 HIN
      DOUBLE PRECISION HNAMES, HABB, HUND
      DIMENSION HNAMES( 103)
C:DIM  HNAMES( 103)
      DATA HNAMES/
     1 6HH     , 6HHE    , 6HLI    , 6HBE    , 6HB     , 6HC     ,
     1 6HN     , 6HO     , 6HF     , 6HNE    , 6HNA    , 6HMG    ,
     1 6HAL    , 6HSI    , 6HP     , 6HS     , 6HCL    , 6HA     ,
     1 6HK     , 6HCA    , 6HSC    , 6HTI    , 6HV     , 6HCR    ,
     1 6HMN    , 6HFE    , 6HCO    , 6HNI    , 6HCU    , 6HZN    ,
     1 6HGA    , 6HGE    , 6HAS    , 6HSE    , 6HBR    , 6HKR    ,
     1 6HRB    , 6HSR    , 6HY     , 6HZR    , 6HNB    , 6HMO    ,
     1 6HTC    , 6HRU    , 6HRH    , 6HPD    , 6HAG    , 6HCD    ,
     1 6HIN    , 6HSN    , 6HSB    , 6HTE    , 6HI     , 6HXE    ,
     1 6HCS    , 6HBA    , 6HLA    , 6HCE    , 6HPR    , 6HND    ,
     1 6HPM    , 6HSM    , 6HEU    , 6HGD    , 6HTB    , 6HDY    ,
     1 6HHO    , 6HER    , 6HTM    , 6HYB    , 6HLU    , 6HHF    ,
     1 6HTA    , 6HW     , 6HRE    , 6HOS    , 6HIR    , 6HPT    ,
     1 6HAU    , 6HHG    , 6HTL    , 6HPB    , 6HBI    , 6HPO    ,
     1 6HAT    , 6HRN    , 6HFR    , 6HRA    , 6HAC    , 6HTH    ,
     1 6HPA    , 6HU     , 6HNP    , 6HPU    , 6HAM    , 6HCM    ,
     1 6HBK    , 6HCF    , 6HES    , 6HFM    , 6HMD    , 6HNO    ,
     1 6HLW    /
      DATA HUND/ 6H------/
      IF ( K.GT.0) GO TO 3
      DO 1 I= 1, 103
      IF ( HABB.EQ. HNAMES( I)) GO TO 2
 1    CONTINUE
       I= 0
 2     IZ= I
      RETURN
C:-------
 3    IF ( IZ.LE. 0) GO TO 4
      IF ( IZ.GT. 103) GO TO 4
       HABB= HNAMES( IZ)
      RETURN
C:-------
 4     HABB= HUND
      RETURN
C:------
      END
C:****END     ZABD
C:****BEGIN   FHETF(                        OMIT FROM NRLEMP
      FUNCTION FHETF( X)
      IF ( X) 1, 2, 3
 1     FHETF= 0.
      RETURN
C:-------
 2     FHETF= 1.
      RETURN
C:-------
 3    IF ( X.LT. 0.05) GO TO 5
      IF ( X.GT. 20.) GO TO 4
       FHETF= 1.5*( 1.0- .75*( 1.0- EXP2F( -23., - X/ .75))/ X)/ X
      RETURN
C:-------
 4     FHETF= 1.5*( 1.0- .75/ X)/ X
      RETURN
C:-------
 5     Z= X/ .75
       ZZ= Z** 2
       ZZZZ= ZZ** 2
       FHETF= ZZZZ/ 360.- Z* ZZ/ 60.+ ZZ/ 12.- Z/ 3.+ 1.
      RETURN
C:-------
      END
C:****END     FHETF(                        OMIT FROM NRLEMP
C:****BEGIN   EMACF(                        OMIT FROM NRLEMP
      FUNCTION EMACF( NZI, WAVE, NOPT, KMAC)
      DIMENSION WE( 9), AT( 4, 4), NFIT( 4), JFT( 10),
     1 XJUMP( 10), ME( 51), SI( 4), SC( 4)
C:DIM  WE( 9), AT( 4, 4), NFIT( 4), JFT( 10),
C:DIM  XJUMP( 10), ME( 51), SI( 4), SC( 4)
      DATA NFIT/ 4, 3, 2, 2/
      DATA XJUMP/ 1., 1., .862, .611, 1., .935, .885, .746, 1., 1./
      DATA JFT/ 1, 3* 2, 5* 3, 4/
      DATA ME/ 23* 0, 3* 1, 16* 3, 5* 4, 3* 8, 9/
       KMAC= 0
      IF ( NZIOLD.EQ. NZI) GO TO 11
       Z= AF( NZI, 1)
       Q= ATWTF( NZI)
       AT( 1, 1)= AF( NZI, 4)
       AT( 1, 2)= AF( NZI, 5)
       AT( 1, 3)= AF( NZI, 6)
       AT( 1, 4)= AF( NZI, 7)
       SI( 1)= AF( NZI, 8)
       SI( 2)= AF( NZI, 9)
       SI( 3)= AF( NZI, 10)
       SI( 4)= AF( NZI, 11)
       SC( 1)= AF( NZI, 12)
       SC( 2)= AF( NZI, 13)
       SC( 3)= AF( NZI, 14)
       SC( 4)= AF( NZI, 15)
       WE( 1)= AF( NZI, 16)
       AT( 2, 1)= AF( NZI, 22)
       AT( 2, 2)= AF( NZI, 23)
       AT( 2, 3)= AF( NZI, 24)
       WE( 2)= AF( NZI, 25)
       WE( 3)= AF( NZI, 26)
       WE( 4)= AF( NZI, 27)
       AT( 3, 1)= AF( NZI, 42)
       AT( 3, 2)= AF( NZI, 43)
       WE( 5)= AF( NZI, 44)
       WE( 6)= AF( NZI, 45)
       WE( 7)= AF( NZI, 46)
       WE( 8)= AF( NZI, 47)
       WE( 9)= AF( NZI, 48)
       AT( 4, 1)= AF( NZI, 50)
       AT( 4, 2)= AF( NZI, 51)
      IF ( Z.EQ. 0.) GO TO 19
      IF ( Q.EQ. 0.) GO TO 19
       CONV= 0.602252/ Q
       XJUMP( 9)= 1./( 1.69- .0037* Z)
 11    NZIOLD= NZI
      IF ( WAVE.LE. 0.) GO TO 19
       E= 2.51754- ALOG( WAVE)
      GO TO( 8, 20, 24, 20, 8), NOPT
 8    DO 12 K= 1, 9
      IF ( WE( K).EQ. 0.) GO TO 13
      IF ( WAVE.LT. WE( K)) GO TO 13
 12   CONTINUE
 9     K= 9+ 1
 13    XJ= XJUMP( K)
       K= JFT( K)
       L2= NFIT( K)
       CON= 1.
       SUM= AT( K, 1)
      DO 14 L= 2, L2
       CON= CON* E
 14    SUM= SUM+ AT( K, L)* CON
      IF ( SUM.EQ. 0.) GO TO 18
       TAU= CONV* XJ* EXP( SUM)
 31   IF ( NOPT.EQ. 5) GO TO 20
       EMACF= TAU
      RETURN
C:-------
 18    KMAC= 1
       TAU= 0.
      GO TO 31
 19    KMAC= 1
       EMACF= 0.
      RETURN
C:-------
 20    SIS= SI( 1)
       CON= 1.
      DO 21 ISI= 2, 4
       CON= CON* E
 21    SIS= SIS+ SI( ISI)* CON
      IF ( SIS.NE. 0.) GO TO 22
       KMAC= 1
       SIS= 0.
      GO TO 23
 22    SIS= CONV* EXP( SIS)
 23   IF ( NOPT.GE. 4) GO TO 24
       EMACF= SIS
      RETURN
C:-------
 24    SCS= SC( 1)
       CON= 1.
      DO 25 ISC= 2, 4
       CON= CON* E
 25    SCS= SCS+ SC( ISC)* CON
      IF ( SCS.NE. 0.) GO TO 26
       KMAC= 1
       SCS= 0.
      GO TO 29
 26    SCS= CONV* EXP( SCS)
 29   IF ( NOPT.NE. 3) GO TO 27
       EMACF= SCS
      RETURN
C:-------
 27   IF ( NOPT.EQ. 5) GO TO 28
       EMACF= SIS+ SCS
      RETURN
C:-------
 28    EMACF= TAU+ SIS+ SCS
      RETURN
C:-------
      END
C:****END     EMACF(                        OMIT FROM NRLEMP
C:****BEGIN   CMACF(                        OMIT FROM NRLEMP
      FUNCTION CMACF( HNAME, WAVE, NOPT, KMAC)
      DOUBLE PRECISION HNAME, HOLD
      DIMENSION NZ( 20), CE(20)
C:DIM  NZ( 20), CE( 20)
      DATA HOLD/ 6H      /
      IF ( HNAME.EQ. HOLD) GO TO 1
      CALL  DEFD( HNAME, R, NEX, NZ, CE, 20, KUF( 3))
       HOLD= HNAME
 1     SUM=0.
       KMAC=0
      DO 2 IEX=1, NEX
       SUM= SUM+ CE( IEX)* EMACF( NZ( IEX), WAVE, NOPT, KMACI)
      IF ( KMACI. NE. 0) KMAC=1
 2    CONTINUE
       CMACF= SUM
      RETURN
C:-------
      END
C:****END     CMACF(                        OMIT FROM NRLEMP
C:****BEGIN   TUBE                          OMIT FROM NRLEMP
      SUBROUTINE TUBE( VOLT, RAD1, NZI, RAD2, BET, NW1, W1, SP1, KP, KW)
      DIMENSION W1( 100), SP1( 100), WC( 100), JEDG( 9)
      DATA JEDG/ 16, 25, 26, 27, 44, 45, 46, 47, 48/
C:----------
C:BUG      WRITE( 6, *) VOLT, RAD1, NZI, RAD2
      WAVEZ= 12.398/ VOLT
      CON1= 0.07958
      ZZ= FLOAT( NZI)
      AZ= ATWTF( NZI)
      NW1= 0
      NWC= 1
      WC( NWC)= WAVEZ
      DO 2 IEDG= 1, 9
      WEDGE= AF( NZI, JEDG( IEDG))
      IF ( WEDGE.LE. 0.) GO TO 2
      IF ( WAVEZ.GE. WEDGE) GO TO 2
      IF ( WEDGE.GE. 12.4) GO TO 2
      NWC= NWC+ 1
      WC( NWC)= WEDGE
      NWC= NWC+ 1
      WC( NWC)= WEDGE
    2 CONTINUE
      QTOT= 0.
      DO 3 IEDG= 1, 4
      WEDGE= AF( NZI, JEDG( IEDG))
      IF ( WEDGE.LE. 0.) GO TO 3
C:XXX
      IF ( WAVEZ.GE. WEDGE) GO TO 3
      QMULT= 0.
      IF ( IEDG.EQ. 1) QMULT= 1.2*( 0.85+ 0.0047* ZZ)
      IF ( IEDG.EQ. 2) QMULT= 0.61+ 0.0058* ZZ
      IF ( IEDG.EQ. 3) QMULT= 0.61+ 0.0058* ZZ
      IF ( IEDG.EQ. 4) QMULT= 2.19+ 0.0098* ZZ
      UZ= WEDGE/ WAVEZ
      QTOT= QTOT+ QMULT*( UZ* ALOG( UZ)-( UZ- 1.))
C:BUG      WRITE( 6, *) IEDG, QMULT, QTOT
    3 CONTINUE
      CON2= 9.54E4/( AZ* 3.E5)
      CON3= 0.5* 2.76E-6* ZZ
      DO 4 IL= 1, 5
      ILT= IL
      WLL= WLF( NZI, ILT)
      IF ( WLL.LE. 0.) GO TO 4
      IF ( WLL.GT. 12.4) GO TO 4
      SPL1= CON2* QTOT* FLF( NZI, ILT, - VOLT, KFL)
      WEL= WEF( NZI, ILT)
      UZ= WEL/ WAVEZ
      IF ( UZ.LE. 0.) GO TO 4
      WAVG= 0.5*( WAVEZ+ WEL)
      SPL2= FLF( NZI, ILT, WAVG, KFL)
      SPL2= SPL2* CON3*( 12.398/ WEL)*( UZ* ALOG( UZ)-( UZ- 1.))
      SPL= SPL1+ SPL2
C:BUG      WRITE( 6, *) IL, WLL, SPL1, SPL2, SPL
      IF ( SPL.LE. 0.) GO TO 4
      SPL= CON1* SPL* FCHIF( VOLT, NZI, WLL, RAD1, RAD2)
      SPL= SPL* EXP2F( -23., - EMACF( 4, WLL, 1, KMAC)* BET)
      IF ( SPL.LE. 0.) GO TO 4
      NW1= NW1+ 1
      W1( NW1)= WLL
C:XXX
      SP1( NW1)= SPL
C:DOC THE FOLLOWING IS AN ARBITRARY ADJUSTMENT TO FIT MEAS. SPECTRA
      SP1( NW1)= SP1( NW1)/ 1.5
      NWC= NWC+ 1
      WC( NWC)= W1( NW1)
    4 CONTINUE
      NL= NW1
C:BUG      WRITE( 6, *) NL,( W1( IL), IL= 1, NL)
      NWC= NWC+ 1
      WC( NWC)= 12.4
C:BUG      WRITE( 6, *) NWC,( WC( IWC), IWC= 1, NWC)
      CALL SORT( WC, NWC, NWC2, 0)
      NWC= NWC2
C:BUG      WRITE( 6, *) NWC,( WC( IWC), IWC= 1, NWC)
      DO 8 IWC= 2, NWC2
      WCI= WC( IWC)
      WLAST= WC( IWC- 1)
    7 WDIFF= WCI- WLAST
      WADD= 0.2* WLAST
      IF ( WDIFF.LE. WADD) GO TO 8
      NWC= NWC+ 1
      WC( NWC)= WLAST+ WADD
      WLAST= WC( NWC)
      GO TO 7
    8 CONTINUE
      CALL SORT( WC, NWC, NWC2, 0)
      NWC= NWC2
      IWC2= NWC
      DO  9 IWC= 2, IWC2
      IF ( WC( IWC).GT. 2.* WAVEZ) GO TO 10
      NWC= NWC+ 1
    9 WC( NWC)= WC( IWC)
   10 CONTINUE
      CALL SORT( WC, NWC, NWC2, 0)
      NWC= NWC2
      NW1= NW1+ 1
      W1( NW1)= WAVEZ
      SP1( NW1)= 0.
      CONST= CON1* 3.42E-5* ZZ/ WAVEZ
      WC( NWC+ 1)= 99999.
      DO 12 IWC= 2, NWC
      NW1= NW1+ 1
      W1( NW1)= WC( IWC)
      SPC= CONST*( W1( NW1)- WAVEZ)/ W1( NW1)** 2
C:BUG      WRITE( 6, *) IWC, NW1, SPC
      WAVE= W1( NW1)
      IF ( WAVE.EQ. WC( IWC- 1)) WAVE= WAVE+ 0.0001
      IF ( WAVE.EQ. WC( IWC+ 1)) WAVE= WAVE- 0.0001
      SPC= SPC* FCHIF( VOLT, NZI, WAVE, RAD1, RAD2)
      SP1( NW1)= SPC* EXP2F( -23., - EMACF( 4, WAVE, 1, KMAC)* BET)
   12 CONTINUE
      IF ( KP.EQ. 0) GO TO 99
      IVOLT= VOLT+ 0.5
      IDEG= RAD2/ 0.017453293+ 0.5
      BEMM= BET/ .185
      WRITE( KW, 201) NZI, IVOLT, IDEG, BEMM, NW1
  201 FORMAT( 2X, 44H# CALCULATED TUBE SPECTRUM FOR ATOMIC NUMBER,
     1 I3, 3H AT, I4, 4H KV,,
     1 / 2X, 6H# WITH, I4, 16H DEG TAKEOFF AND, F5.2, 14H MM BE WINDOW:,
     1 / 2X, I4, 28H # POINTS IN THE TABULATION.)
      IF ( NL.GT. 0) WRITE( KW, 202) NL
  202 FORMAT( 2X, 5H# THE, I2, 37H LINES (WAVELENGTH AND INTENSITY) ARE)
      IF ( NL.GT. 0) WRITE( KW, 203) ( W1( IW), SP1( IW), IW= 1, NL)
  203 FORMAT( 2X, F10.4, E12.4, F10.4, E12.4, F10.4, E12.4)
      IW1= NL+ 1
      WRITE( KW, 204)
  204 FORMAT( 2X, 50H# CONTINUUM (WAVELENGTH AND INTENSITY/ANGSTROM) IS)
      WRITE( KW, 203) ( W1( IW), SP1( IW), IW= IW1, NW1)
C:BUG      WRITE( 6, *) NW1,( W1( I), SP1( I), I= 1, NW1)
   99 RETURN
      END
C:****END     TUBE                          OMIT FROM NRLEMP
C:****BEGIN   FCHIF(                        OMIT FROM NRLEMP
      FUNCTION FCHIF( VOLT, NZI, WAVE, RAD1, RAD2)
      DATA NZIL/ 0/, RAD1L/ 0./, RAD2L/ 0./
      IF ( RAD1.EQ. RAD1L) GO TO 4
      CON1= 1.0- 0.5* COS( RAD1)** 2
      RAD1L= RAD1
    4 IF ( RAD2.EQ. RAD2L) GO TO 6
      CSC2= 1./ SIN( RAD2)
      RAD2L= RAD2
    6 CONTINUE
      CHI= CON1* EMACF( NZI, WAVE, 1, KMAC)* CSC2
      SIGMA= 4.5E5/( VOLT** 1.65- (12.398/ WAVE)** 1.65)
      ARG= 1.+ CHI/ SIGMA
      IF ( NZI.EQ. NZIL) GO TO 10
      ARGH= 1.2* ATWTF( NZI)/ FLOAT( NZI)** 2
      NZIL= NZI
   10 FCHIF= ( 1.+ ARGH)/( ARG*( 1.+ ARGH* ARG))
C:BUG      WRITE( 6, *) WAVE, CHI, SIGMA, FCHIF
      RETURN
      END
C:****END     FCHIF(                        OMIT FROM NRLEMP
C:****BEGIN   IN
      SUBROUTINE IN( NU, N, IE, KEND, HIN)
C:DOC NU IS THE INPUT UNIT NUMBER.
C:DOC N  IS THE MAXIMUM NUMBER OF DATA TO BE REFORMATTED.
C:DOC IE= 0  END-OF-RECORD IS END-OF-FILE.
C:DOC IE= 1  END-OF RECORD IS EMPTY LINE.
C:DOC IE= 2  END-OF-RECORD IS END OF LINE (NOT COMMENT).
C:DOC KE IS THE NUMBER OF DATA FOUND (TO END-OF-RECORD, OR TO N).
C:DOC KE= -1 IMPLIES THAT AN END-OF-FILE MARK WAS SENSED.
C:
C:DOC END-OF-RECORD AND END-OF-FILE MARKS ARE DEFINED IN " IN2".
C:DOC THE END-OF-FILE MARK MUST BE IN THE FIRST COLUMN TO BE READ.
C:DOC AN END-OF-RECORD MARK THERE IS THE SAME AS AN END-OF-FILE.
       Character*16 HIN
      DIMENSION HIN( 200)
      DATA KB/ 1/, KA/ 1/, KC/ 1/, KS/ 2/, KW/ 6/, NC/ 16/
      DATA KTI/ 5/, KTO/ 6/
      IF ( N.LT. 0) GO TO 2
      CALL IN2( NU, N, IE, KEND,
     1  KB, KA, KC, KS, KTI, KTO, KW, NC, HIN)
 1    RETURN
C:-------
 2     KEND= 0
      IF ( N.EQ. -1) GO TO 5
      IF ( N.EQ. -2) GO TO 3
      IF ( N.LT. -7) GO TO 1
 4    IF ( N.EQ. -1) KB= NU
      IF ( N.EQ. -2) KA= NU
      IF ( N.EQ. -3) KS= NU
      IF ( N.EQ. -4) KTI= NU
      IF ( N.EQ. -5) KW= NU
      IF ( N.EQ. -6) NC= NU
      IF ( N.EQ. -7) KC= NU
       KEND= N
      GO TO 1
C:-------
 3    IF ( NU.GE. 0) GO TO 4
       KA= - KA
       KEND= N
      GO TO 1
C:-------
 5    IF ( NU.GE. 0) GO TO 4
       KB= - KB
       KEND= N
      GO TO 1
C:-------
      END
C:****END     IN
C:****BEGIN   IN2
      SUBROUTINE IN2( KR, N, IE, KEND,
     1  KB, KA, KC, KS, KTI, KTO, KW, NC, HIN)
       Character*16 HIN
      DIMENSION H( 5, 80), NIU( 5), I1K( 5), I2K( 5)
      DIMENSION HSIGN( 2), HDIG( 11), HFILL( 80), HIN( 200)
      DATA NIU/ 5* -99/
      DATA HBLNK/ 1H /, HCOMM/ 1H,/, HEOL/ 1H;/
      DATA HDIG/ 1H0, 1H1, 1H2, 1H3, 1H4, 1H5, 1H6, 1H7,
     1 1H8, 1H9, 1H./, HSIGN/ 1H+, 1H-/, HFILL/ 80* 1H /
      DATA HREM/ 1H#/, HEOF/ 1H;/
      DATA I1K/ 5* 81/, I2K/ 5* 80/
C:----------
 9001 CONTINUE
C:SCR      REWIND KS
       NR= 0
       NR1= -1
       KEND= 0
       KEOL= 0
       KEOR= 0
       KEOF= 0
C:
C:DOC FIND THE BUFFER NUMBER, IU; IF FOUND GO TO 38
      DO 30 IU= 1, 5
      IF ( NIU( IU).EQ. KR) GO TO 38
 30   CONTINUE
      IF ( N.EQ. 0) I1K( IU)= 81
      IF ( N.EQ. 0) GO TO 98
C:DOC FIND AN EMPTY BUFFER TO USE; IF FOUND, GO TO 38
      DO 32 IU= 1, 5
      IF ( I1K( IU).GT. I2K( IU)) GO TO 38
 32   CONTINUE
C:DOC IF ALL BUFFERS IN USE, DELETE BUFFER 1 AND USE IT
      WRITE( KW, 109)
 109  FORMAT( 2X, 43H WARN.. ALL 5 INPUT BUFFERS ALREADY IN USE.)
       IU= 1
      WRITE( KW, 108) NIU( IU)
 108  FORMAT( 2X, 24H WARN.. BUFFER FOR UNIT , I3, 10H REPLACED.)
       I1K( IU)= 81
       I2K( IU)= 80
C:
C:DOC BUFFER HAS BEEN SELECTED.  IF N=0, EMPTY IT AND RETURN.
C:DOC IF IT IS ALREADY EMPTY, AND N NOT =0, GO TO 1 (INPUT).
C:DOC ELSE, GO TO 51 (PROCESS).
 38    I1= I1K( IU)
      IF ( N.EQ. 0) I1K( IU)= 81
      IF ( N.EQ. 0) GO TO 98
      IF ( KB.LE. 0) I1= 81
       ILAST= I2K( IU)
      IF ( KB.LE. 0) ILAST= 80
       NIU( IU)= KR
       J1= I1
      IF ( I1.LE. ILAST) GO TO 51
C:
C:DOC BUFFER IS EMPTY.  READ ONE LINE, PROMPTING IF APPROPRIATE.
C:
 1    DO 2 I= 1, 80
 2     H( IU, I)= HBLNK
       NR1= NR
 9105 IF ( KR.EQ. KTI) WRITE( KTO, 105)
      READ( KR, 101, END= 97) ( H( IU, J), J= 1, 80)
C:CDC      READ( KR, 101) ( H( IU, J), J= 1, 80)
C:DOC FIRST CHARACTER PROCESSED TO BE COLUMN 1 OR COLUMN 7.
       I1= 1
 9007 IF ( KR.NE. KUF( 5)) I1= 7
       I11= I1
       J1= I1
       ILAST= 80
C:DOC DROP TRAILING BLANKS AND COMMAS
       ILIM= 81- I1
      DO 20 I= 1, ILIM
      IF ( H( IU, 81- I).EQ. HBLNK) GO TO 20
      IF ( H( IU, 81- I).EQ. HCOMM) GO TO 20
      GO TO 22
   20 CONTINUE
       I= ILIM+ 1
   22  ILAST= 81- I
      IF ( ILAST.LT. I1) KEOL= 1
      IF ( H( IU, I1).EQ. HEOF) GO TO 97
      IF ( H( IU, I1).EQ. HEOL) GO TO 99
      IF ( H( IU, I1).NE. HREM) GO TO 51
C:
C:DOC  REMAINDER IS COMMENT.  WRITE; IF NOT EOR, GO TO 1 (INPUT).
 3    CONTINUE
      IF ( KR.EQ. KTI) GO TO 13
      IF ( I1.EQ. I11) GO TO 11
      IF ( KA.LE. 0) GO TO 13
      IF ( KC.LE. 0) GO TO 13
 11   WRITE( KW, 107) ( H( IU, J), J= I1, ILAST)
 13   CONTINUE
      IF ( NR.EQ. 0) GO TO 1
      IF ( IE.EQ. 2) KEOR= 1
      IF ( KEOR.EQ. 0) GO TO 1
       I1= 81
       ILAST= 80
      GO TO 90
C:-------
C:DOC FIND NEXT SIGNIFICANT CHARACTER.  IF COMMENT, GO TO 3.
C:DOC IF NO REMAINING SIGNIFICANT CHARACTER,  GO TO 12.
C:DOC IF EOR, FINISH.  IF DATUM, GO TO 7; ELSE FINISH.
 51   IF ( I1.GT. ILAST) GO TO 12
      DO 6 I= I1, ILAST
      IF ( H( IU, I).EQ. HBLNK) GO TO 6
      IF ( H( IU, I).EQ. HCOMM) GO TO 6
      IF ( H( IU, I).NE. HREM) GO TO 52
       I1= I
      GO TO 3
C:    -------
    6 CONTINUE
      I1= 81
      GO TO 12
C:-------
 52   IF ( H( IU, I).NE. HEOL) GO TO 7
       KEOL= 1
      IF ( IE.EQ. 2) KEOR= 1
       I1= I+ 1
      GO TO 14
C:-------
C:DOC A DATUM IS FOUND.  IF WANTED, FIND ITS LENGTH; ELSE FINISH.
 7     NR= NR+ 1
       I1= I
      IF ( NR.GE. N) KEOR= 1
      IF ( NR.GT. N) GO TO 90
 61   DO 8 I= I1, ILAST
      IF ( H( IU, I).EQ. HBLNK) GO TO 9
      IF ( H( IU, I).EQ. HCOMM) GO TO 9
      IF ( H( IU, I).EQ. HREM) GO TO 9
      IF ( H( IU, I).EQ. HEOL) GO TO 9
    8 CONTINUE
       I= ILAST+ 1
 9     I2= I- 1
       I2P= I2
       I3= I
       NII= I- I1
      IF ( NII.GT. NC) I2= I1+ NC- 1
       NII= I2+ 1- I1
C:DOC IS THE DATUM NUMERIC?  IF SO, GO TO 44; ELSE GO TO 50.
       NFILL= 0
       HTEST= H( IU, I1)
      IF ( HTEST.NE. HSIGN( 1)) GO TO 41
      GO TO 45
C:-------
 41   IF ( HTEST.NE. HSIGN( 2)) GO TO 42
 45    NFILL= 1
       HTEST= H( IU, I1+ 1)
 42   DO 43 J= 1, 11
      IF ( HTEST.EQ. HDIG( J)) GO TO 44
   43 CONTINUE
       NFILL= 0
      GO TO 50
C:-------
C:DOC DATUM IS NUMERIC.  CALCULATE NO. OF BLANKS TO RIGHT-JUSTIFY.
 44    NFILL= NC- NII
      IF ( I2P.NE. I2) WRITE( KW, 111) ( H( IU, J), J= I1, I2P)
      IF ( I2P.NE. I2) WRITE( KW, 112) ( H( IU, J), J= I1, I2)
C:DOC WRITE ANY FILL BLANKS AND DATUM TO SCRATCH FILE.
 50   CONTINUE
C:SCR      IF ( NFILL.EQ. 0) WRITE( KS, 102) ( H( IU, I), I= I1, I2)
      IF ( NFILL.EQ. 0)
     1 ENCODE( NC, 102, HIN( 4* NR- 3)) ( H( IU, I), I= I1, I2)
C:SCR      IF ( NFILL.NE. 0) WRITE( KS, 102)
C:SCR     1 ( HFILL( I), I= 1, NFILL), ( H( IU, I), I= I1, I2)
      IF ( NFILL.NE. 0)
     1 ENCODE( NC, 102, HIN( 4* NR- 3))
     1 ( HFILL( I), I= 1, NFILL), ( H( IU, I), I= I1, I2)
       I1= I3+ 1
      IF ( KEOR.NE. 0) GO TO 14
      IF ( H( IU, I3).EQ. HEOL) I1= I3
      IF ( H( IU, I3).EQ. HEOF) I1= I3
      IF ( I1.LE. ILAST) GO TO 51
C:
C:DOC THE ENTIRE LINE HAS BEEN PROCESSED.  PARROT?  RETURN?
 12   CONTINUE
      IF ( KA.LE. 0) GO TO 62
C:ALT      IF ( NR.EQ. NR1) GO TO 62
C:BAT      GO TO 63
      IF ( KR.NE. KTI) GO TO 63
      IF ( J1.NE. 1) GO TO 63
      GO TO 62
C:    -------
 63   IF ( KR.EQ. KTI) WRITE( KW, 103) ( H( IU, J), J= J1, I2P)
      IF ( KR.NE. KTI) WRITE( KW, 104) ( H( IU, J), J= J1, I2P)
       J1= I2P+ 2
 62   CONTINUE
      IF ( KEOR.NE. 0) GO TO 90
      IF ( IE.EQ. 2) GO TO 90
      IF ( IE.EQ. 0) GO TO 1
      IF ( IE.NE. 1) GO TO 1
      IF ( NR1.EQ. NR) GO TO 90
      GO TO 1
C:-------
 14   CONTINUE
      IF ( KA.LE. 0) GO TO 88
C:BAT      GO TO 63
      IF ( KR.NE. KTI) GO TO 89
      IF ( J1.NE. 1) GO TO 89
      IF ( I2P.NE. ILAST) GO TO 89
      GO TO 88
C:    -------
 89   IF ( KR.EQ. KTI) WRITE( KW, 103) ( H( IU, J), J= J1, I2P)
      IF ( KR.NE. KTI) WRITE( KW, 104) ( H( IU, J), J= J1, I2P)
       J1= I2P+ 2
 88   CONTINUE
      IF ( KEOR.NE. 0) GO TO 90
      IF ( I1.LE. ILAST) GO TO 51
      GO TO 1
 90   CONTINUE
C:SCR      ENDFILE KS
 9002 CONTINUE
C:SCR      REWIND KS
       I1K( IU)= I1
       I2K( IU)= ILAST
 98    KEND= NR
      RETURN
C:-------
 97   WRITE( KW, 106) NIU( IU)
      CALL ERROR( 0)
      NR= -1
       I1= 81
      GO TO 90
C:-------
 99   IF ( N.GT. 0) WRITE( KW, 106) NIU( IU)
      NR= -1
       I1= 81
      GO TO 90
C:-------
 101  FORMAT( 80A1)
 102  FORMAT( 80A1)
 103  FORMAT( 1X, 4H( *  , 80A1)
 104  FORMAT( 1X, 4H( *  , 80A1)
C:>>> USE ONLY ONE VERSION OF     105 FORMAT
C:  USED ON DEC-10 TO SUPPRESS CARRIAGE-RETURN AND LINE FEED:
 105  FORMAT( 3H *  $)
C:   105   FORMAT( 3H * )
C:CDC105   FORMAT( 3H * ^)
 106  FORMAT( 2X, 28H; END-OF-FILE ON UNIT NUMBER, I3)
 107  FORMAT( 1X, 80A1)
 111  FORMAT( 2X, 18HWARN: INPUT DATUM , 60A1)
 112  FORMAT( 2X, 18H     TRUNCATED TO , 60A1)
      END
C:****END     IN2
C:****BEGIN   SOLV      OMIT FROM NRLSIM
      SUBROUTINE SOLV( M, N, C, IC, V, IV, R, IR, KW, IK)
      DOUBLE PRECISION DD
      DIMENSION C( IC, M), V( IV, N), R( IR, N)
      DIMENSION DD( 22, 52)
      DATA MXMN/ 1144/
      KP= 1
      IF ( IK.EQ. -9) KP= 0
       NN= M+ N
       KMXMN= 0
      IF (( M* NN).GT. MXMN) KMXMN= 1
      IF ( IC.LT. M) GO TO 91
      IF ( IV.LT. M) GO TO 91
      IF ( IR.LT. M) GO TO 91
      IF ( KMXMN.NE. 0) GO TO 91
       NN= M+ N
      IK= 0
      CALL SOLV2( M, N, C, IC, V, IV, R, IR, DD, NN, KW, IK, KP)
      RETURN
 91   WRITE( KW, 901) M, N
 901  FORMAT( 2X, 31H >>>>> DIM. ERROR IN CALL SOLV(, I3, 1H,, I3)
      IF ( KMXMN.NE. 0) WRITE( KW, 902) M, M, N, MXMN
 902  FORMAT( 2X, 5X, I3, 2H*(, I3, 1H+, I3, 15H) GREATER THAN , I5)
      STOP 777
C:DEC10      RETURN
      END
C:****END     SOLV      OMIT FROM NRLSIM
C:****BEGIN   SOLV2     OMIT FROM NRLSIM
      SUBROUTINE SOLV2( M, N, C, IC, V, IV, R, IR, DD, NN, KW, IK, KP)
      DOUBLE PRECISION DD
      DIMENSION C( IC, M), V( IV, N), R( IR, N)
      DIMENSION DD( M, NN)
      DO 5 I= 1, M
       XMX= 0.
      DO 1 J= 1, M
       TMX= ABS( C( I, J))
      IF ( TMX.GT. XMX) XMX= TMX
    1 CONTINUE
      DO 2 J= 1, N
       TMX= ABS( V( I, J))
      IF ( TMX.GT. XMX) XMX= TMX
    2 CONTINUE
      IF ( XMX.GT. 0.) GO TO 7
      IF ( KP.NE. 0) WRITE( KW, 901) I
      IK= - 1
      RETURN
C:-------
 7     XMX= 1./ XMX
      DO 3 J= 1, M
 3     DD( I, J)= C( I, J)* XMX
      DO 4 J= 1, N
 4     DD( I, M+ J)= V( I, J)* XMX
 5    CONTINUE
      CALL SOLV3( DD, M, NN, IK)
      IF ( IK.EQ. 0) GO TO 8
      IF ( KP.NE. 0) WRITE( KW, 902) M, N, IK
      RETURN
C:-------
 8    DO 6 I= 1, M
      DO 6 J= 1, N
 6     R( I, J)= DD( I, M+ J)
      RETURN
 901  FORMAT( 2X, 15H >>>>> EQUATION, I3, 20H EMPTY, IN SUB SOLV.)
 902  FORMAT( 2X, 23H >>>>> NUM. ERR:  SOLV(, I3, 1H,, I3, 4H, AT, I3)
      END
C:****END     SOLV2     OMIT FROM NRLSIM
C:****BEGIN   SOLV3     OMIT FROM NRLSIM
      SUBROUTINE SOLV3( DD, MM, NN, IK)
      DOUBLE PRECISION DD, DTEMP
      DIMENSION DD( MM, NN)
       N= MM
       N1= N+ 1
       L= N- 1
       IK= 0
      DO 911 I= 1, L
      DO 903 J= I, N
      IF ( DD( J, I).NE. 0.) GO TO 904
 903  CONTINUE
       IK= I
      RETURN
 904  IF ( I.EQ. J) GO TO 907
      DO 906 K= 1, NN
       DTEMP= DD( I, K)
       DD( I, K)= DD( J, K)
 906   DD( J, K)= DTEMP
 907   KK= I+ 1
      IF ( DD( I, I).EQ. 0.) IK= I
      IF ( DD( I, I).EQ. 0.) RETURN
      DO 910 J= KK, N
      IF ( DD( J, I).EQ. 0.) GO TO 910
       DTEMP= DD( J, I)/ DD( I, I)
      DO 909 K= KK, NN
 909   DD( J, K)= DD( J, K)- DTEMP* DD( I, K)
 910  CONTINUE
 911  CONTINUE
      IF ( DD( N, N).EQ. 0.) IK= N
      IF ( DD( N, N).EQ. 0.) RETURN
      DO 920 INN= N1, NN
       DD( N, INN)= DD( N, INN)/ DD( N, N)
      DO 913 I= 2, N
       J= N1- I
       DTEMP= 0.
       KK= J+ 1
      DO 912 K= KK, N
 912   DTEMP= DTEMP- DD( J, K)* DD( K, INN)
 913   DD( J, INN)= ( DTEMP+ DD( J, INN))/ DD( J, J)
 920  CONTINUE
      RETURN
      END
C:****END     SOLV3     OMIT FROM NRLSIM
